{-# 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.Bifunctor (second)
import Data.Char  (toLower)

import BNFC.CF
import BNFC.Utils
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
"  void onEmptyLine(void);",
    String
"  void removeTrailingSpaces(void);",
    String
"  void removeTrailingWhitespace(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 (Bool -> (Cat, [Rule]) -> String
prDataH Bool
useStl) [(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 :: Bool -> (Cat, [Rule]) -> String
prDataH :: Bool -> (Cat, [Rule]) -> String
prDataH Bool
useSTL (Cat
cat, [Rule]
rules)
 | Cat -> Bool
isList Cat
cat = [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] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"  void visit", String
cl, String
"(", String
cl, String
" *p);"          ] ]
     , Bool -> [String] -> [String]
forall m. Monoid m => Bool -> m -> m
when Bool
useSTL
       [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"  void iter", String
cl, String
"(", String
itty, String
" i, ", String
itty, String
" j);" ] ]
     ]
 | Bool
otherwise  = 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)
   itty :: String
itty     = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
cl, String
"::", String
"const_iterator" ]
   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
catToStr 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
"/*** 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
catToStr 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 (STL version).
--
genPrintVisitorList :: (Cat, [Rule]) -> Doc
genPrintVisitorList :: (Cat, [Rule]) -> Doc
genPrintVisitorList (cat :: Cat
cat@(ListCat Cat
_), [Rule]
rules) = [Doc] -> Doc
vcat
  [ Doc
"void PrintAbsyn::visit" Doc -> Doc -> Doc
<> Doc
lty Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc
lty Doc -> Doc -> Doc
<+> Doc
"*" Doc -> Doc -> Doc
<> Doc
vname)
  , Int -> [Doc] -> Doc
codeblock Int
2
    [ Doc
"iter" Doc -> Doc -> Doc
<> Doc
lty Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc
vname Doc -> Doc -> Doc
<> Doc
"->begin()" Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Doc
vname Doc -> Doc -> Doc
<> Doc
"->end()") Doc -> Doc -> Doc
<> Doc
semi ]
  , Doc
""
  , Doc
"void PrintAbsyn::iter" Doc -> Doc -> Doc
<> Doc
lty Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc
itty Doc -> Doc -> Doc
<+> Doc
"i" Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Doc
itty Doc -> Doc -> Doc
<+> Doc
"j")
  , Int -> [Doc] -> Doc
codeblock Int
2 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs0 then
      [ Doc
"if (i == j) return;" ]
      else
      [ Doc
"if (i == j)"
      , Doc
"{ /* nil */"
      , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs0
      , Doc
"}"
      , Doc
"else"
      ]
    , Bool -> [Doc] -> [Doc]
forall m. Monoid m => Bool -> m -> m
unless ([Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs1)
      [ Doc
"if (i == j-1)"
      , Doc
"{ /* last */"
      , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs1
      , Doc
"}"
      , Doc
"else"
      ]
    , [ Doc
"{ /* cons */"
      ,  Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs2
      , Doc
"}"
      ]
    ]
  , Doc
""
  , Doc
""
  ]
  where
  cl :: String
cl        = Cat -> String
identCat (Cat -> Cat
normCat Cat
cat)
  lty :: Doc
lty       = String -> Doc
text String
cl                   -- List type
  itty :: Doc
itty      = Doc
lty Doc -> Doc -> Doc
<> Doc
"::const_iterator" -- Iterator type
  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
  prules :: [(Integer, Rule)]
prules    = [Rule] -> [(Integer, Rule)]
sortRulesByPrecedence [Rule]
rules
  swRules :: ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
f = Doc -> [(Integer, Doc)] -> [Doc]
switchByPrecedence Doc
"_i_" ([(Integer, Doc)] -> [Doc]) -> [(Integer, Doc)] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                ((Integer, Rule) -> (Integer, Doc))
-> [(Integer, Rule)] -> [(Integer, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc))
-> (Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc)
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> (Rule -> [Doc]) -> Rule -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> [Doc]
forall a. IsFun a => Rul a -> [Doc]
prListRule_) ([(Integer, Rule)] -> [(Integer, Doc)])
-> [(Integer, Rule)] -> [(Integer, Doc)]
forall a b. (a -> b) -> a -> b
$
                  ((Integer, Rule) -> Integer)
-> [(Integer, Rule)] -> [(Integer, Rule)]
forall b a. Eq b => (a -> b) -> [a] -> [a]
uniqOn (Integer, Rule) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, Rule)] -> [(Integer, Rule)])
-> [(Integer, Rule)] -> [(Integer, Rule)]
forall a b. (a -> b) -> a -> b
$ ((Integer, Rule) -> Bool) -> [(Integer, Rule)] -> [(Integer, Rule)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer, Rule) -> Bool
f [(Integer, Rule)]
prules
                  -- Discard duplicates, can only handle one rule per precedence.
  docs0 :: [Doc]
docs0     = ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isNilFun
  docs1 :: [Doc]
docs1     = ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isOneFun
  docs2 :: [Doc]
docs2     = ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isConsFun

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

-- | Only render the rhs (items) of a list rule.

prListRule_ :: IsFun a => Rul a -> [Doc]
prListRule_ :: forall a. IsFun a => Rul a -> [Doc]
prListRule_ (Rule a
_ RCat
_ SentForm
items InternalRule
_) = SentForm -> (Either Cat String -> Doc) -> [Doc]
forall a b. [a] -> (a -> b) -> [b]
for SentForm
items ((Either Cat String -> Doc) -> [Doc])
-> (Either Cat String -> Doc) -> [Doc]
forall a b. (a -> b) -> a -> b
$ \case
  Right String
t       -> Doc
"render(" Doc -> Doc -> Doc
<> String -> Doc
text ((Char, String) -> String
forall a b. (a, b) -> b
snd (String -> (Char, String)
renderCharOrString String
t)) Doc -> Doc -> Doc
<> Doc
");"
  Left Cat
c
    | Just{} <- Cat -> Maybe String
maybeTokenCat Cat
c
                -> Doc
"visit" Doc -> Doc -> Doc
<> Doc
dat Doc -> Doc -> Doc
<> Doc
"(*i);"
    | Cat -> Bool
isList Cat
c  -> Doc
"iter" Doc -> Doc -> Doc
<> Doc
dat Doc -> Doc -> Doc
<> Doc
"(i+1, j);"
    | Bool
otherwise -> Doc
"(*i)->accept(this);"
    where
    dat :: Doc
dat = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat (Cat -> String) -> Cat -> String
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCat Cat
c

-- This is the only part of the pretty printer that differs significantly
-- between the versions with and without STL.
-- The present version has been adapted from CFtoCPrinter.
genPrintVisitorListNoStl :: (Cat, [Rule]) -> String
genPrintVisitorListNoStl :: (Cat, [Rule]) -> String
genPrintVisitorListNoStl (cat :: Cat
cat@(ListCat Cat
_), [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
"  if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
+++ String
"== 0)"
      , String
"  { /* nil */"
      ]
    , [Doc] -> ([Doc] -> [String]) -> [String]
forall m a. Monoid m => [a] -> ([a] -> m) -> m
unlessNull (((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isNilFun) (([Doc] -> [String]) -> [String])
-> ([Doc] -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ [Doc]
docs ->
      [ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs ]
    , [ String
"  }" ]
    , [Doc] -> ([Doc] -> [String]) -> [String]
forall m a. Monoid m => [a] -> ([a] -> m) -> m
unlessNull (((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isOneFun) (([Doc] -> [String]) -> [String])
-> ([Doc] -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ [Doc]
docs ->
      [ String
"  else if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_ == 0)"
      , String
"  { /* last */"
      , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs
      , String
"  }"
      ]
    , [Doc] -> ([Doc] -> [String]) -> [String]
forall m a. Monoid m => [a] -> ([a] -> m) -> m
unlessNull (((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
forall a. IsFun a => a -> Bool
isConsFun) (([Doc] -> [String]) -> [String])
-> ([Doc] -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ [Doc]
docs ->
      [ String
"  else"
      , String
"  { /* cons */"
      , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs
      , 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
  pre :: String
pre         = String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->"
  prules :: [(Integer, Rule)]
prules      = [Rule] -> [(Integer, Rule)]
sortRulesByPrecedence [Rule]
rules
  swRules :: ((Integer, Rule) -> Bool) -> [Doc]
swRules (Integer, Rule) -> Bool
f   = Doc -> [(Integer, Doc)] -> [Doc]
switchByPrecedence Doc
"_i_" ([(Integer, Doc)] -> [Doc]) -> [(Integer, Doc)] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                  ((Integer, Rule) -> (Integer, Doc))
-> [(Integer, Rule)] -> [(Integer, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc))
-> (Rule -> Doc) -> (Integer, Rule) -> (Integer, Doc)
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep ([Doc] -> Doc) -> (Rule -> [Doc]) -> Rule -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> (Rule -> [String]) -> Rule -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Rule -> [String]
forall a. IsFun a => String -> Rul a -> [String]
prPrintRule_ String
pre) ([(Integer, Rule)] -> [(Integer, Doc)])
-> [(Integer, Rule)] -> [(Integer, Doc)]
forall a b. (a -> b) -> a -> b
$
                    ((Integer, Rule) -> Integer)
-> [(Integer, Rule)] -> [(Integer, Rule)]
forall b a. Eq b => (a -> b) -> [a] -> [a]
uniqOn (Integer, Rule) -> Integer
forall a b. (a, b) -> a
fst ([(Integer, Rule)] -> [(Integer, Rule)])
-> [(Integer, Rule)] -> [(Integer, Rule)]
forall a b. (a -> b) -> a -> b
$ ((Integer, Rule) -> Bool) -> [(Integer, Rule)] -> [(Integer, Rule)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer, Rule) -> Bool
f [(Integer, Rule)]
prules
                    -- Discard duplicates, can only handle one rule per precedence.
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
_ InternalRule
_) | RFun -> Bool
forall a. IsFun a => a -> Bool
isProperLabel RFun
fun = [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]
++ 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 -> String
parenCode String
"_L_PAREN"
    , String
""
    ]
  , String -> Rule -> [String]
forall a. IsFun a => String -> Rul a -> [String]
prPrintRule_ (String
fnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->") Rule
r
  , [ String
""
    , String -> String
parenCode String
"_R_PAREN"
    , String
"  _i_ = oldi;"
    , String
"}"
    , String
""
    ]
  ]
  where
  p :: Integer
p = Rule -> Integer
forall f. Rul f -> Integer
precRule Rule
r
  parenCode :: String -> String
parenCode String
x = 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
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
  fnm :: String
fnm = String
"p" --old names could cause conflicts
prPrintRule Maybe String
_ Rule
_ = String
""

prPrintRule_ :: IsFun a => String -> Rul a -> [String]
prPrintRule_ :: forall a. IsFun a => String -> Rul a -> [String]
prPrintRule_ String
pre (Rule a
_ RCat
_ SentForm
items InternalRule
_) = (Either (Cat, Doc) String -> String)
-> [Either (Cat, Doc) String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Either (Cat, Doc) String -> String
prPrintItem String
pre) ([Either (Cat, Doc) String] -> [String])
-> [Either (Cat, Doc) String] -> [String]
forall a b. (a -> b) -> a -> b
$ SentForm -> [Either (Cat, Doc) String]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
items

--This goes on to recurse to the instance variables.
prPrintItem :: String -> Either (Cat, Doc) String -> String
prPrintItem :: String -> Either (Cat, Doc) String -> String
prPrintItem String
_   (Right String
t) = String
"  render(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char, String) -> String
forall a b. (a, b) -> b
snd (String -> (Char, String)
renderCharOrString String
t) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
prPrintItem String
pre (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
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
  | Cat -> Bool
isList Cat
c  = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
setI (Cat -> Integer
precCat Cat
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
"visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
elt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
  | Bool
otherwise = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
setI (Cat -> Integer
precCat Cat
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->accept(this);"
  where
  s :: String
s   = Doc -> String
render Doc
nt
  elt :: String
elt = Cat -> String
identCat (Cat -> String) -> Cat -> String
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCat Cat
c

{- **** 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
catToStr 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
"     onEmptyLine();",
      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
"     removeTrailingWhitespace();",
      String
"     bufAppend(c);",
      String
"     bufAppend(' ');",
      String
"  }",
      String
"  else if (c == '}')",
      String
"  {",
      String
"     _n_ = _n_ - INDENT_WIDTH;",
      String
"     onEmptyLine();",
      String
"     bufAppend(c);",
      String
"     bufAppend('\\n\');",
      String
"     indent();",
      String
"  }",
      String
"  else if (c == ',')",
      String
"  {",
      String
"     removeTrailingWhitespace();",
      String
"     bufAppend(c);",
      String
"     bufAppend(' ');",
      String
"  }",
      String
"  else if (c == ';')",
      String
"  {",
      String
"     removeTrailingWhitespace();",
      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 (cur_ && buf_[cur_ - 1] == ' ')"
    , String
"    buf_[--cur_] = 0;"
    , String
"}"
    , String
""
    , String
"void PrintAbsyn::removeTrailingSpaces()"
    , String
"{"
    , String
"  while (cur_ && buf_[cur_ - 1] == ' ') --cur_;"
    , String
"  buf_[cur_] = 0;"
    , String
"}"
    , String
""
    , String
"void PrintAbsyn::removeTrailingWhitespace()"
    , String
"{"
    , String
"  while (cur_ && (buf_[cur_ - 1] == ' ' || buf_[cur_ - 1] == '\\n')) --cur_;"
    , String
"  buf_[cur_] = 0;"
    , String
"}"
    , String
""
    , String
"void PrintAbsyn::onEmptyLine()"
    , String
"{"
    , String
"  removeTrailingSpaces();"
    , String
"  if (cur_ && buf_[cur_ - 1 ] != '\\n') bufAppend('\\n');"
    , String
"  indent();"
    , String
"}"
    , String
""
    ]
  ]