{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{-
   **************************************************************
    BNF Converter Module

    Description   : This module generates the C++ Pretty Printer.
                    It also generates the "show" method for
                    printing an abstract syntax tree.

                    The generated files use the Visitor design pattern.

    Author        : Michael Pellauer
    Created       : 10 August, 2003
    Modified      : 3 September, 2003
                    * Added resizable buffers

   **************************************************************
-}

module BNFC.Backend.CPP.PrettyPrinter (cf2CPPPrinter, prRender) where

import Prelude hiding ((<>))

import Data.Char(toLower)

import BNFC.CF
import BNFC.Utils ((+++), when)
import BNFC.Backend.Common
import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.Common.StrUtils (renderCharOrString)
import BNFC.Backend.CPP.STL.STLUtils
import BNFC.PrettyPrint

--Produces (.H file, .C file)
cf2CPPPrinter :: Bool -> Maybe String -> CF -> (String, String)
cf2CPPPrinter :: Bool -> Maybe String -> CF -> (String, String)
cf2CPPPrinter Bool
useStl Maybe String
inPackage CF
cf =
    (Bool -> Maybe String -> CF -> [(Cat, [Rule])] -> String
mkHFile Bool
useStl Maybe String
inPackage CF
cf [(Cat, [Rule])]
groups, Bool -> Maybe String -> CF -> [(Cat, [Rule])] -> String
mkCFile Bool
useStl Maybe String
inPackage CF
cf [(Cat, [Rule])]
groups)
 where
    groups :: [(Cat, [Rule])]
groups = Bool -> [(Cat, [Rule])] -> [(Cat, [Rule])]
forall m. Monoid m => Bool -> m -> m
when Bool
useStl (CF -> [(Cat, [Rule])]
positionRules CF
cf)  -- CPP/NoSTL treats position tokens as just tokens
          [(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])]
forall a. [a] -> [a] -> [a]
++ [(Cat, [Rule])] -> [(Cat, [Rule])]
fixCoercions (CF -> [(Cat, [Rule])]
ruleGroupsInternals CF
cf)

positionRules :: CF -> [(Cat,[Rule])]
positionRules :: CF -> [(Cat, [Rule])]
positionRules CF
cf =
  [ (String -> Cat
TokenCat String
cat, [ RFun -> RCat -> SentForm -> InternalRule -> Rule
forall function.
function -> RCat -> SentForm -> InternalRule -> Rul function
Rule (String -> RFun
forall a. a -> WithPosition a
noPosition String
cat) (Cat -> RCat
forall a. a -> WithPosition a
noPosition (Cat -> RCat) -> Cat -> RCat
forall a b. (a -> b) -> a -> b
$ String -> Cat
TokenCat String
cat) ((String -> Either Cat String) -> [String] -> SentForm
forall a b. (a -> b) -> [a] -> [b]
map (Cat -> Either Cat String
forall a b. a -> Either a b
Left (Cat -> Either Cat String)
-> (String -> Cat) -> String -> Either Cat String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Cat
TokenCat) [String
catString, String
catInteger]) InternalRule
Parsable ])
  | String
cat <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (CF -> String -> Bool
forall f. CFG f -> String -> Bool
isPositionCat CF
cf) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, Reg) -> String) -> [(String, Reg)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Reg) -> String
forall a b. (a, b) -> a
fst (CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf)
  ]

{- **** Header (.H) File Methods **** -}

--An extremely large function to make the Header File
mkHFile :: Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String
mkHFile :: Bool -> Maybe String -> CF -> [(Cat, [Rule])] -> String
mkHFile Bool
useStl Maybe String
inPackage CF
cf [(Cat, [Rule])]
groups = [String] -> String
unlines
  [ String
printHeader
  , String
content
  , String
classFooter
  , String
showHeader
  , String
content
  , String
classFooter
  , String
footer
  ]
  where
  printHeader :: String
printHeader = [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
"",
    String
"#include \"Absyn.H\"",
    String
"#include <stdio.h>",
    String
"#include <string.h>",
    String
"#include <stdlib.h>",
    String
"",
    Maybe String -> String
nsStart Maybe String
inPackage,
    String
"/* Certain applications may improve performance by changing the buffer size */",
    String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"BUFFER_INITIAL" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 2000",
    String
"/* You may wish to change _L_PAREN or _R_PAREN */",
    String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_L_PAREN" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" '('",
    String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_R_PAREN" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ')'",
    String
"",
    String
"class PrintAbsyn : public Visitor",
    String
"{",
    String
" protected:",
    String
"  int _n_, _i_;",
    String
"  /* The following are simple heuristics for rendering terminals */",
    String
"  /* You may wish to change them */",
    String
"  void render(Char c);",
    if Bool
useStl then String
"  void render(String s);" else String
"",
    String
"  void render(const char *s);",
    String
"  void indent(void);",
    String
"  void backup(void);",
    String
" public:",
    String
"  PrintAbsyn(void);",
    String
"  ~PrintAbsyn(void);",
    String
"  char *print(Visitable *v);"
   ]
  hdef :: String
hdef = Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"PRINTER_HEADER"
  content :: String
content = ((Cat, [Rule]) -> String) -> [(Cat, [Rule])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Cat, [Rule]) -> String
prDataH [(Cat, [Rule])]
groups
  classFooter :: String
classFooter = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
   [
    String
"  void visitInteger(Integer i);",
    String
"  void visitDouble(Double d);",
    String
"  void visitChar(Char c);",
    String
"  void visitString(String s);",
    String
"  void visitIdent(String s);"
   ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"  void visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(String s);" | String
t <- CF -> [String]
forall f. CFG f -> [String]
tokenNames CF
cf] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
   [
    String
" protected:",
    String
"  char *buf_;",
    String
"  int cur_, buf_size;",
    String
"",
    String
"  void inline bufAppend(const char *s)",
    String
"  {",
    String
"    int end = cur_ + strlen(s);",
    String
"    if (end >= buf_size) {",
    String
"      do buf_size *= 2; /* Double the buffer size */",
    String
"      while (end >= buf_size);",
    String
"      resizeBuffer();",
    String
"    }",
    String
"    strcpy(&buf_[cur_], s);",
    String
"    cur_ = end;",
    String
"  }",
    String
"",
    String
"  void inline bufAppend(const char c)",
    String
"  {",
    String
"    if (cur_ + 1 >= buf_size)",
    String
"    {",
    String
"      buf_size *= 2; /* Double the buffer size */",
    String
"      resizeBuffer();",
    String
"    }",
    String
"    buf_[cur_] = c;",
    String
"    buf_[++cur_] = 0;",
    String
"  }",
    String
"",
    if Bool
useStl then Doc -> String
render (Int -> Doc -> Doc
nest Int
2 Doc
bufAppendString) else String
"",
    String
"  void inline bufReset(void)",
    String
"  {",
    String
"    if (buf_) free(buf_);",
    String
"    buf_size = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"BUFFER_INITIAL" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";",
    String
"    buf_ = (char *) malloc(buf_size);",
    String
"    if (!buf_) {",
    String
"      fprintf(stderr, \"Error: Out of memory while allocating buffer!\\n\");",
    String
"      exit(1);",
    String
"    }",
    String
"    memset(buf_, 0, buf_size);",
    String
"    cur_ = 0;",
    String
"  }",
    String
"",
    String
"  void inline resizeBuffer(void)",
    String
"  {",
    String
"    char *temp = (char *) malloc(buf_size);",
    String
"    if (!temp)",
    String
"    {",
    String
"      fprintf(stderr, \"Error: Out of memory while attempting to grow buffer!\\n\");",
    String
"      exit(1);",
    String
"    }",
    String
"    if (buf_)",
    String
"    {",
    String
"      strcpy(temp, buf_);",
    String
"      free(buf_);",
    String
"    }",
    String
"    buf_ = temp;",
    String
"  }",
    String
"};",
    String
""
   ]
  bufAppendString :: Doc
  bufAppendString :: Doc
bufAppendString =
      Doc
"void inline bufAppend(String str)"
      Doc -> Doc -> Doc
$$ Int -> [Doc] -> Doc
codeblock Int
2
          [ Doc
"const char *s = str.c_str();"
          , Doc
"bufAppend(s);"
          ]
  showHeader :: String
showHeader = [String] -> String
unlines
   [
    String
"",
    String
"class ShowAbsyn : public Visitor",
    String
"{",
    String
" public:",
    String
"  ShowAbsyn(void);",
    String
"  ~ShowAbsyn(void);",
    String
"  char *show(Visitable *v);"
   ]
  footer :: String
footer = [String] -> String
unlines
   [
    Maybe String -> String
nsEnd Maybe String
inPackage,
    String
"",
    String
"#endif"
   ]

--Prints all the required method names and their parameters.
prDataH :: (Cat, [Rule]) -> String
prDataH :: (Cat, [Rule]) -> String
prDataH (Cat
cat, [Rule]
rules) =
 if Cat -> Bool
isList Cat
cat
 then [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"  void visit", String
cl, String
"(", String
cl, String
" *p);\n"]
 else String
abstract String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rule -> String) -> [Rule] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rule -> String
forall f. IsFun f => Rul f -> String
prRuleH [Rule]
rules
 where
   cl :: String
cl = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
   abstract :: String
abstract = case RFun -> [Rule] -> Maybe (Cat, SentForm)
forall f. Eq f => f -> [Rul f] -> Maybe (Cat, SentForm)
lookupRule (String -> RFun
forall a. a -> WithPosition a
noPosition (String -> RFun) -> String -> RFun
forall a b. (a -> b) -> a -> b
$ Cat -> String
forall a. Show a => a -> String
show Cat
cat) [Rule]
rules of
    Just (Cat, SentForm)
_ -> String
""
    Maybe (Cat, SentForm)
Nothing ->  String
"  void 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
forall a. [a] -> [a] -> [a]
++ String
" *p); /* abstract class */\n"

--Prints all the methods to visit a rule.
prRuleH :: IsFun f => Rul f -> String
prRuleH :: forall f. IsFun f => Rul f -> String
prRuleH (Rule f
fun RCat
_ SentForm
_ InternalRule
_) | f -> Bool
forall a. IsFun a => a -> Bool
isProperLabel f
fun = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [String
"  void visit", f -> String
forall a. IsFun a => a -> String
funName f
fun, String
"(", f -> String
forall a. IsFun a => a -> String
funName f
fun, String
" *p);\n"]
prRuleH Rul f
_ = String
""

{- **** Implementation (.C) File Methods **** -}

--This makes the .C file by a similar method.
mkCFile :: Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String
mkCFile :: Bool -> Maybe String -> CF -> [(Cat, [Rule])] -> String
mkCFile Bool
useStl Maybe String
inPackage CF
cf [(Cat, [Rule])]
groups = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
   [
    String
header,
    Maybe String -> String
nsStart Maybe String
inPackage String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n",
    Bool -> String
prRender Bool
useStl,
    String
printEntries,
    ((Cat, [Rule]) -> String) -> [(Cat, [Rule])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Maybe String -> CF -> (Cat, [Rule]) -> String
prPrintData Bool
useStl Maybe String
inPackage CF
cf) [(Cat, [Rule])]
groups,
    String
printBasics,
    String
printTokens,
    String
showEntries,
    ((Cat, [Rule]) -> String) -> [(Cat, [Rule])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (Cat, [Rule]) -> String
prShowData Bool
useStl) [(Cat, [Rule])]
groups,
    String
showBasics,
    String
showTokens,
    Maybe String -> String
nsEnd Maybe String
inPackage String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
   ]
  where
    header :: String
header = [String] -> String
unlines
     [
      String
"/*** BNFC-Generated Pretty Printer and Abstract Syntax Viewer ***/",
      String
"",
      String
"#include <string>",
      String
"#include \"Printer.H\"",
      String
"#define INDENT_WIDTH 2",
      String
""
     ]
    printEntries :: String
printEntries = [String] -> String
unlines
     [
      String
"PrintAbsyn::PrintAbsyn(void)",
      String
"{",
      String
"  _i_ = 0; _n_ = 0;",
      String
"  buf_ = 0;",
      String
"  bufReset();",
      String
"}",
      String
"",
      String
"PrintAbsyn::~PrintAbsyn(void)",
      String
"{",
      String
"}",
      String
"",
      String
"char *PrintAbsyn::print(Visitable *v)",
      String
"{",
      String
"  _i_ = 0; _n_ = 0;",
      String
"  bufReset();",
      String
"  v->accept(this);",
      String
"  return buf_;",
      String
"}",
      String
""
     ]
    showEntries :: String
showEntries = [String] -> String
unlines
     [
      String
"ShowAbsyn::ShowAbsyn(void)",
      String
"{",
      String
"  buf_ = 0;",
      String
"  bufReset();",
      String
"}",
      String
"",
      String
"ShowAbsyn::~ShowAbsyn(void)",
      String
"{",
      String
"}",
      String
"",
      String
"char *ShowAbsyn::show(Visitable *v)",
      String
"{",
      String
"  bufReset();",
      String
"  v->accept(this);",
      String
"  return buf_;",
      String
"}",
      String
""
     ]
    printBasics :: String
printBasics = [String] -> String
unlines
     [
      String
"void PrintAbsyn::visitInteger(Integer i)",
      String
"{",
      String
"  char tmp[20];",
      String
"  sprintf(tmp, \"%d\", i);",
      String
"  render(tmp);",
      String
"}",
      String
"",
      String
"void PrintAbsyn::visitDouble(Double d)",
      String
"{",
      String
"  char tmp[24];",
      String
"  sprintf(tmp, \"%.15g\", d);",
      String
"  render(tmp);",
      String
"}",
      String
"",
      String
"void PrintAbsyn::visitChar(Char c)",
      String
"{",
      String
"  char tmp[4];",
      String
"  sprintf(tmp, \"'%c'\", c);",
      String
"  render(tmp);",
      String
"}",
      String
"",
      String
"void PrintAbsyn::visitString(String s)",
      String
"{",
      String
"  bufAppend('\\\"');",
      String
"  bufAppend(s);",
      String
"  bufAppend('\\\"');",
      String
"  bufAppend(' ');",
      String
"}",
      String
"",
      String
"void PrintAbsyn::visitIdent(String s)",
      String
"{",
      String
"  render(s);",
      String
"}",
      String
""
     ]

    printTokens :: String
printTokens = [String] -> String
unlines
     [[String] -> String
unlines [
      String
"void PrintAbsyn::visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(String s)",
      String
"{",
      String
"  render(s);",
      String
"}",
      String
""
      ] | String
t <- CF -> [String]
forall f. CFG f -> [String]
tokenNames CF
cf
     ]

    showBasics :: String
showBasics = [String] -> String
unlines
     [
      String
"void ShowAbsyn::visitInteger(Integer i)",
      String
"{",
      String
"  char tmp[20];",
      String
"  sprintf(tmp, \"%d\", i);",
      String
"  bufAppend(tmp);",
      String
"}",
      String
"void ShowAbsyn::visitDouble(Double d)",
      String
"{",
      String
"  char tmp[24];",
      String
"  sprintf(tmp, \"%.15g\", d);",
      String
"  bufAppend(tmp);",
      String
"}",
      String
"void ShowAbsyn::visitChar(Char c)",
      String
"{",
      String
"  bufAppend('\\'');",
      String
"  bufAppend(c);",
      String
"  bufAppend('\\'');",
      String
"}",
      String
"void ShowAbsyn::visitString(String s)",
      String
"{",
      String
"  bufAppend('\\\"');",
      String
"  bufAppend(s);",
      String
"  bufAppend('\\\"');",
      String
"}",
      String
"void ShowAbsyn::visitIdent(String s)",
      String
"{",
      String
"  bufAppend('\\\"');",
      String
"  bufAppend(s);",
      String
"  bufAppend('\\\"');",
      String
"}",
      String
""
     ]

    showTokens :: String
showTokens = [String] -> String
unlines
     [[String] -> String
unlines [
      String
"void ShowAbsyn::visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(String s)",
      String
"{",
      String
"  bufAppend('\\\"');",
      String
"  bufAppend(s);",
      String
"  bufAppend('\\\"');",
      String
"}",
      String
""
      ] | String
t <- CF -> [String]
forall f. CFG f -> [String]
tokenNames CF
cf
     ]


{- **** Pretty Printer Methods **** -}

-- | Generates methods for the Pretty Printer.
prPrintData :: Bool -> Maybe String -> CF -> (Cat, [Rule]) -> String
prPrintData :: Bool -> Maybe String -> CF -> (Cat, [Rule]) -> String
prPrintData Bool
True {- use STL -} Maybe String
_ CF
_ (cat :: Cat
cat@(ListCat Cat
_), [Rule]
rules) =
    Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ (Cat, [Rule]) -> Doc
genPrintVisitorList (Cat
cat, [Rule]
rules)
prPrintData Bool
False {- use STL -} Maybe String
_ CF
_ (cat :: Cat
cat@(ListCat Cat
_), [Rule]
rules) =
    (Cat, [Rule]) -> String
genPrintVisitorListNoStl (Cat
cat, [Rule]
rules)
-- Not a list :
prPrintData Bool
_ Maybe String
_inPackage CF
cf (TokenCat String
cat, [Rule]
_rules) | CF -> String -> Bool
forall f. CFG f -> String -> Bool
isPositionCat CF
cf String
cat = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  -- a position token
  [ String
"void PrintAbsyn::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
cat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *p)"
  , String
"{"
  , String
"  visitIdent(p->string_);"
  , String
"}"
  , String
""
  ]
prPrintData Bool
_ Maybe String
inPackage CF
_cf (Cat
cat, [Rule]
rules) = -- Not a list
    String
abstract String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rule -> String) -> [Rule] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe String -> Rule -> String
prPrintRule Maybe String
inPackage) [Rule]
rules
  where
  cl :: String
cl = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
  abstract :: String
abstract = case RFun -> [Rule] -> Maybe (Cat, SentForm)
forall f. Eq f => f -> [Rul f] -> Maybe (Cat, SentForm)
lookupRule (String -> RFun
forall a. a -> WithPosition a
noPosition (String -> RFun) -> String -> RFun
forall a b. (a -> b) -> a -> b
$ Cat -> String
forall a. Show a => a -> String
show Cat
cat) [Rule]
rules of
    Just (Cat, SentForm)
_ -> String
""
    Maybe (Cat, SentForm)
Nothing ->  String
"void PrintAbsyn::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
"*p) {} //abstract class\n\n"

-- | Generate pretty printer visitor for a list category:
--
-- >>> let c = Cat "C" ; lc = ListCat c
-- >>> let rules = [npRule "[]" lc [] Parsable, npRule "(:)" lc [Left c, Right "-", Left lc] Parsable]
-- >>> genPrintVisitorList (lc, rules)
-- void PrintAbsyn::visitListC(ListC *listc)
-- {
--   for (ListC::const_iterator i = listc->begin() ; i != listc->end() ; ++i)
--   {
--     (*i)->accept(this);
--     render('-');
--   }
-- }
--
-- >>> let c2 = CoercCat "C" 2 ; lc2 = ListCat c2
-- >>> let rules2 = rules ++ [npRule "[]" lc2 [] Parsable, npRule "(:)" lc2 [Left c2, Right "+", Left lc2] Parsable]
-- >>> genPrintVisitorList (lc, rules2)
-- void PrintAbsyn::visitListC(ListC *listc)
-- {
--   for (ListC::const_iterator i = listc->begin() ; i != listc->end() ; ++i)
--   {
--     (*i)->accept(this);
--     switch(_i_)
--     {
--       case 2: render('+'); break;
--       default: render('-');
--     }
--   }
-- }
genPrintVisitorList :: (Cat, [Rule]) -> Doc
genPrintVisitorList :: (Cat, [Rule]) -> Doc
genPrintVisitorList (cat :: Cat
cat@(ListCat Cat
c), [Rule]
rules) =
    Doc
"void PrintAbsyn::visit" Doc -> Doc -> Doc
<> String -> Doc
text String
cl Doc -> Doc -> Doc
<> Doc
"(" Doc -> Doc -> Doc
<> String -> Doc
text String
cl Doc -> Doc -> Doc
<> Doc
" *" Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
")"
    Doc -> Doc -> Doc
$$ Int -> [Doc] -> Doc
codeblock Int
2
      [ Doc
"for ("Doc -> Doc -> Doc
<> String -> Doc
text String
cl Doc -> Doc -> Doc
<> Doc
"::const_iterator i = " Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
"->begin() ; i != " Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
"->end() ; ++i)"
      , Int -> [Doc] -> Doc
codeblock Int
2
          [ if Cat -> Bool
isTokenCat Cat
c
              then Doc
"visit" Doc -> Doc -> Doc
<> String -> Doc
text (String -> String
forall {a}. [a] -> [a]
baseName String
cl) Doc -> Doc -> Doc
<> Doc
"(*i) ;"
              else Doc
"(*i)->accept(this);"
          , (if [Rule] -> Bool
hasOneFunc [Rule]
rules
              then Doc
"if (i != " Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
"->end() - 1)"
              else Doc
empty)
            Doc -> Doc -> Doc
<+> Doc -> (String -> Doc) -> [(Integer, String)] -> Doc
renderListSepByPrecedence Doc
"_i_" String -> Doc
renderSep [(Integer, String)]
separators
          ]
      ]
  where
   separators :: [(Integer, String)]
separators  = [Rule] -> [(Integer, String)]
getSeparatorByPrecedence [Rule]
rules
   cl :: String
cl          = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
   vname :: Doc
vname       = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cl
   renderSep :: String -> Doc
renderSep String
s = Doc
"render(" Doc -> Doc -> Doc
<> String -> Doc
text ((Char, String) -> String
forall a b. (a, b) -> b
snd (String -> (Char, String)
renderCharOrString String
s)) Doc -> Doc -> Doc
<> Doc
")"

genPrintVisitorList (Cat, [Rule])
_ = String -> Doc
forall a. HasCallStack => String -> a
error String
"genPrintVisitorList expects a ListCat"

-- | This is the only part of the pretty printer that differs significantly
-- between the versions with and without STL.
genPrintVisitorListNoStl :: (Cat, [Rule]) -> String
genPrintVisitorListNoStl :: (Cat, [Rule]) -> String
genPrintVisitorListNoStl (cat :: Cat
cat@(ListCat Cat
c), [Rule]
rules) = [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
"void PrintAbsyn::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
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
"  while(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
+++ String
"!= 0)"
    , String
"  {"
    , String
"    if (" 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
"_ == 0)"
    , String
"    {"
    , String
visitMember
    ]
  , [String]
optsep
  , [ String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
+++ String
"= 0;"
    , String
"    }"
    , String
"    else"
    , String
"    {"
    , String
visitMember
    , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
6 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> (String -> Doc) -> [(Integer, String)] -> Doc
renderListSepByPrecedence Doc
"_i_" String -> Doc
renderSep [(Integer, String)]
separators
    , String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
+++ String
"=" String -> String -> String
+++ 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
"}"
    , String
""
    ]
  ]
  where
    visitMember :: String
visitMember
      | Just String
t <- Cat -> Maybe String
maybeTokenCat Cat
c =
          String
"      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
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
member String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
      | Bool
otherwise =
          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
member String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->accept(this);"
    cl :: String
cl     = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
    ecl :: String
ecl    = Cat -> String
identCat (Cat -> Cat
normCatOfList Cat
cat)
    vname :: String
vname  = (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
"_"
    optsep :: [String]
optsep = if [Rule] -> Bool
hasOneFunc [Rule]
rules Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sep' then []
             else [ String
"      render(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");" ]
    sep' :: String
sep' = (Char, String) -> String
forall a b. (a, b) -> b
snd ((Char, String) -> String) -> (Char, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (Char, String)
renderCharOrString (String -> (Char, String)) -> String -> (Char, String)
forall a b. (a -> b) -> a -> b
$ [Rule] -> String
getCons [Rule]
rules
    renderSep :: String -> Doc
renderSep String
s = Doc
"render(" Doc -> Doc -> Doc
<> String -> Doc
text ((Char, String) -> String
forall a b. (a, b) -> b
snd ((Char, String) -> String) -> (Char, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (Char, String)
renderCharOrString String
s) Doc -> Doc -> Doc
<> Doc
")"
    separators :: [(Integer, String)]
separators = [Rule] -> [(Integer, String)]
getSeparatorByPrecedence [Rule]
rules
genPrintVisitorListNoStl (Cat, [Rule])
_ = String -> String
forall a. HasCallStack => String -> a
error String
"genPrintVisitorListNoStl expects a ListCat"

--Pretty Printer methods for a rule.
prPrintRule :: Maybe String -> Rule -> String
prPrintRule :: Maybe String -> Rule -> String
prPrintRule Maybe String
inPackage r :: Rule
r@(Rule RFun
fun RCat
_ SentForm
cats InternalRule
_) | RFun -> Bool
forall a. IsFun a => a -> Bool
isProperLabel RFun
fun = [String] -> String
unlines
  [
   String
"void PrintAbsyn::visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RFun -> String
forall a. IsFun a => a -> String
funName RFun
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RFun -> String
forall a. IsFun a => a -> String
funName RFun
fun String -> String -> String
+++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")",
   String
"{",
   String
"  int oldi = _i_;",
   String
lparen,
   String
cats',
   String
rparen,
   String
"  _i_ = oldi;",
   String
"}",
   String
""
  ]
   where
    p :: Integer
p = Rule -> Integer
forall f. Rul f -> Integer
precRule Rule
r
    (String
lparen, String
rparen) =
      (String
"  if (oldi > " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") render(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_L_PAREN" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n",
       String
"  if (oldi > " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") render(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_R_PAREN" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n")
    cats' :: String
cats' = (Either (Cat, Doc) String -> String)
-> [Either (Cat, Doc) String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Either (Cat, Doc) String -> String
prPrintCat String
fnm) (SentForm -> [Either (Cat, Doc) String]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats)
    fnm :: String
fnm = String
"p" --old names could cause conflicts
prPrintRule Maybe String
_ Rule
_ = String
""

--This goes on to recurse to the instance variables.
prPrintCat :: String -> Either (Cat, Doc) String -> String
prPrintCat :: String -> Either (Cat, Doc) String -> String
prPrintCat String
_ (Right String
t) = String
"  render(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
  where t' :: String
t' = (Char, String) -> String
forall a b. (a, b) -> b
snd (String -> (Char, String)
renderCharOrString String
t)
prPrintCat String
fnm (Left (Cat
c, Doc
nt))
  | Just String
t <- Cat -> Maybe String
maybeTokenCat Cat
c
              = String
"  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
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"
  | Cat -> Bool
isList Cat
c  = String
"  if(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
accept String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}\n"
  | Bool
otherwise = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
accept String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
  where
    s :: String
s = Doc -> String
render Doc
nt
    accept :: String
accept = Integer -> String
setI (Cat -> Integer
precCat Cat
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->accept(this);"

{- **** Abstract Syntax Tree Printer **** -}

--This prints the functions for Abstract Syntax tree printing.
prShowData :: Bool -> (Cat, [Rule]) -> String
prShowData :: Bool -> (Cat, [Rule]) -> String
prShowData Bool
True (cat :: Cat
cat@(ListCat Cat
c), [Rule]
_) = [String] -> String
unlines
 [
  String
"void ShowAbsyn::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
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
"  for ("String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cl String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"::const_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 Cat -> Bool
isTokenCat Cat
c
    then String
"    visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall {a}. [a] -> [a]
baseName String
cl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(*i) ;"
    else String
"    (*i)->accept(this);",
  String
"    if (i != " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->end() - 1) bufAppend(\", \");",
  String
"  }",
  String
"}",
  String
""
 ]
  where
    cl :: String
cl = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
    vname :: String
vname = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cl
prShowData Bool
False (cat :: Cat
cat@(ListCat Cat
c), [Rule]
_) =
 [String] -> String
unlines
 [
  String
"void ShowAbsyn::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
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
"  while(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!= 0)",
  String
"  {",
  String
"    if (" 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
visitMember,
  String
"      bufAppend(\", \");",
  String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
+++ String
"=" String -> String -> String
+++ 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
"    else",
  String
"    {",
  String
visitMember,
  String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = 0;",
  String
"    }",
  String
"  }",
  String
"}",
  String
""
 ]
  where
    cl :: String
cl = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
    ecl :: String
ecl = Cat -> String
identCat (Cat -> Cat
normCatOfList Cat
cat)
    vname :: String
vname = (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
"_"
    visitMember :: String
visitMember
      | Just String
t <- Cat -> Maybe String
maybeTokenCat Cat
c =
          String
"      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
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
member String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
      | Bool
otherwise =
          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
member String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->accept(this);"
prShowData Bool
_ (Cat
cat, [Rule]
rules) =  --Not a list:
  String
abstract String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Rule -> String) -> [Rule] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rule -> String
forall f. IsFun f => Rul f -> String
prShowRule [Rule]
rules
  where
    cl :: String
cl = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
    abstract :: String
abstract = case RFun -> [Rule] -> Maybe (Cat, SentForm)
forall f. Eq f => f -> [Rul f] -> Maybe (Cat, SentForm)
lookupRule (String -> RFun
forall a. a -> WithPosition a
noPosition (String -> RFun) -> String -> RFun
forall a b. (a -> b) -> a -> b
$ Cat -> String
forall a. Show a => a -> String
show Cat
cat) [Rule]
rules of
      Just (Cat, SentForm)
_ -> String
""
      Maybe (Cat, SentForm)
Nothing ->  String
"void ShowAbsyn::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
forall a. [a] -> [a] -> [a]
++ String
" *p) {} //abstract class\n\n"

--This prints all the methods for Abstract Syntax tree rules.
prShowRule :: IsFun f => Rul f -> String
prShowRule :: forall f. IsFun f => Rul f -> String
prShowRule (Rule f
f RCat
_ SentForm
cats InternalRule
_) | f -> Bool
forall a. IsFun a => a -> Bool
isProperLabel f
f = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [
   String
"void ShowAbsyn::visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
+++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\n",
   String
"{\n",
   String
lparen,
   String
"  bufAppend(\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\");\n",
   String
optspace,
   String
cats',
   String
rparen,
   String
"}\n"
  ]
   where
    fun :: String
fun = f -> String
forall a. IsFun a => a -> String
funName f
f
    (String
optspace, String
lparen, String
rparen, String
cats')
      | [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ () | Left Cat
_ <- SentForm
cats ]  -- @all isRight cats@, but Data.Either.isRight requires base >= 4.7
                  = (String
"", String
"", String
"", String
"")
      | Bool
otherwise = (String
"  bufAppend(' ');\n", String
"  bufAppend('(');\n",String
"  bufAppend(')');\n"
                    , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
forall {a}. (Eq a, IsString a) => [a] -> [a]
insertSpaces ((Either (Cat, Doc) String -> String)
-> [Either (Cat, Doc) String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Either (Cat, Doc) String -> String
prShowCat String
fnm) (SentForm -> [Either (Cat, Doc) String]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats))))
    insertSpaces :: [a] -> [a]
insertSpaces [] = []
    insertSpaces (a
x:[]) = [a
x]
    insertSpaces (a
x:[a]
xs) = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
""
      then [a] -> [a]
insertSpaces [a]
xs
      else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
"  bufAppend(' ');\n" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
insertSpaces [a]
xs
    fnm :: String
fnm = String
"p" --other names could cause conflicts
prShowRule Rul f
_ = String
""

-- This recurses to the instance variables of a class.
prShowCat :: String -> Either (Cat, Doc) String -> String
prShowCat :: String -> Either (Cat, Doc) String -> String
prShowCat String
_   (Right String
_) = String
""
prShowCat String
fnm (Left (Cat
cat, Doc
nt))
  | Just String
t <- Cat -> Maybe String
maybeTokenCat Cat
cat =
      [String] -> String
unlines
        [ String
"  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
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
        ]
  | Cat -> String
catToStr (Cat -> Cat
normCat (Cat -> Cat) -> Cat -> Cat
forall a b. (a -> b) -> a -> b
$ String -> Cat
strToCat String
s) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
s =
      [String] -> String
unlines
        [ String
accept
        ]
  | Bool
otherwise =
      [String] -> String
unlines
        [ String
"  bufAppend('[');"
        , String
"  if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
accept
        , String
"  bufAppend(']');"
        ]
  where
  s :: String
s = Doc -> String
render Doc
nt
  accept :: String
accept = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->accept(this);"

{- **** Helper Functions Section **** -}

-- from ListIdent to Ident
baseName :: [a] -> [a]
baseName = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
4


--Just sets the coercion level for parentheses in the Pretty Printer.
setI :: Integer -> String
setI :: Integer -> String
setI Integer
n = String
"_i_ = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; "

--An extremely simple renderer for terminals.
prRender :: Bool -> String
prRender :: Bool -> String
prRender Bool
useStl = [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
"//You may wish to change render",
      String
"void PrintAbsyn::render(Char c)",
      String
"{",
      String
"  if (c == '{')",
      String
"  {",
      String
"     bufAppend('\\n');",
      String
"     indent();",
      String
"     bufAppend(c);",
      String
"     _n_ = _n_ + INDENT_WIDTH;",
      String
"     bufAppend('\\n');",
      String
"     indent();",
      String
"  }",
      String
"  else if (c == '(' || c == '[')",
      String
"     bufAppend(c);",
      String
"  else if (c == ')' || c == ']')",
      String
"  {",
      String
"     backup();",
      String
"     bufAppend(c);",
      String
"     bufAppend(' ');",
      String
"  }",
      String
"  else if (c == '}')",
      String
"  {",
      String
"     int t;",
      String
"     _n_ = _n_ - INDENT_WIDTH;",
      String
"     for (t=0; t<INDENT_WIDTH; t++) {",
      String
"       backup();",
      String
"     }",
      String
"     bufAppend(c);",
      String
"     bufAppend('\\n\');",
      String
"     indent();",
      String
"  }",
      String
"  else if (c == ',')",
      String
"  {",
      String
"     backup();",
      String
"     bufAppend(c);",
      String
"     bufAppend(' ');",
      String
"  }",
      String
"  else if (c == ';')",
      String
"  {",
      String
"     backup();",
      String
"     bufAppend(c);",
      String
"     bufAppend('\\n');",
      String
"     indent();",
      String
"  }",
      String
"  else if (c == ' ') bufAppend(c);",
      String
"  else if (c == 0) return;",
      String
"  else",
      String
"  {",
      String
"     bufAppend(c);",
      String
"     bufAppend(' ');",
      String
"  }",
      String
"}",
      String
""
    ]
  , Bool -> [String] -> [String]
forall m. Monoid m => Bool -> m -> m
when Bool
useStl
    [ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
        [ Doc
"void PrintAbsyn::render(String s)"
        , Int -> [Doc] -> Doc
codeblock Int
2
            [ Doc
"render(s.c_str());"
            ]
        , Doc
""
        ]
    ]
  , [ String
"bool allIsSpace(const char *s)"
    , String
"{"
    , String
"  char c;"
    , String
"  while ((c = *s++))"
    , String
"    if (! isspace(c)) return false;"
    , String
"  return true;"
    , String
"}"
    , String
""
    ]
  , [ String
"void PrintAbsyn::render(const char *s)"
    , String
"{"
    , String
"  if (*s) /* C string not empty */"
    , String
"  {"
    , String
"    if (allIsSpace(s)) {"
    , String
"      backup();"
    , String
"      bufAppend(s);"
    , String
"    } else {"
    , String
"      bufAppend(s);"
    , String
"      bufAppend(' ');"
    , String
"    }"
    , String
"  }"
    , String
"}"
    , String
""
    , String
"void PrintAbsyn::indent()"
    , String
"{"
    , String
"  int n = _n_;"
    , String
"  while (--n >= 0)"
    , String
"    bufAppend(' ');"
    , String
"}"
    , String
""
    , String
"void PrintAbsyn::backup()"
    , String
"{"
    , String
"  if (buf_[cur_ - 1] == ' ')"
    , String
"    buf_[--cur_] = 0;"
    , String
"}"
    , String
""
    ]
  ]