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

{-
    BNF Converter: Java Pretty Printer generator
    Copyright (C) 2004  Author:  Michael Pellauer, Bjorn Bringert

    Description   : This module generates the Java Pretty Printer
                    class. In addition, since there's no good way
                    to display a class heirarchy (toString() doesn't
                    count) in Java, it generates a method that
                    displays the Abstract Syntax in a way similar
                    to Haskell.

                    This uses Appel's method and may serve as a
                    useful example to those who wish to use it.

    Author        : Michael Pellauer (pellauer@cs.chalmers.se),
                    Bjorn Bringert (bringert@cs.chalmers.se)

    Created       : 24 April, 2003

    Modified      : 9 Aug, 2004
    Added string buffer for efficiency (Michael, August 03)

-}

module BNFC.Backend.Java.CFtoJavaPrinter15 ( cf2JavaPrinter ) where

import Prelude hiding ((<>))

import Data.Bifunctor ( second )
import Data.Char      ( toLower, isSpace )
import Data.Either    ( lefts )
import Data.List      ( intersperse )
import Data.Maybe     ( isJust )

import BNFC.CF
import BNFC.PrettyPrint
import BNFC.Utils     ( (+++), for, unless, unlessNull, uniqOn )

import BNFC.Backend.Common ( switchByPrecedence )
import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.Java.CFtoJavaAbs15

--Produces the PrettyPrinter class.
--It will generate two methods "print" and "show"
--print is the actual pretty printer for linearization.
--show produces a Haskell-style syntax that can be extremely useful
--especially for testing parser correctness.

cf2JavaPrinter :: String -> String -> CF -> String
cf2JavaPrinter :: [Char] -> [Char] -> CF -> [Char]
cf2JavaPrinter [Char]
packageBase [Char]
packageAbsyn CF
cf =
  [[Char]] -> [Char]
unlines
   [
    [Char]
header,
    [Char] -> CF -> [Char]
prEntryPoints [Char]
packageAbsyn CF
cf,
    [[Char]] -> [Char]
unlines (((Cat, [Rule]) -> [Char]) -> [(Cat, [Rule])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> (Cat, [Rule]) -> [Char]
prData [Char]
packageAbsyn [[Char]]
user) [(Cat, [Rule])]
groups),
    [[Char]] -> [Char]
unlines (((Cat, [Rule]) -> [Char]) -> [(Cat, [Rule])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> (Cat, [Rule]) -> [Char]
shData [Char]
packageAbsyn [[Char]]
user) [(Cat, [Rule])]
groups),
    [Char]
footer
   ]
  where
    user :: [[Char]]
user = [[Char]
n | ([Char]
n,Reg
_) <- CF -> [([Char], Reg)]
forall f. CFG f -> [([Char], Reg)]
tokenPragmas CF
cf]
    groups :: [(Cat, [Rule])]
groups = [(Cat, [Rule])] -> [(Cat, [Rule])]
fixCoercions (CF -> [(Cat, [Rule])]
ruleGroupsInternals CF
cf)
    header :: [Char]
header = [[Char]] -> [Char]
unlines [
      [Char]
"package" [Char] -> [Char] -> [Char]
+++ [Char]
packageBase [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";",
      [Char]
"",
      [Char]
"public class PrettyPrinter",
      [Char]
"{",
      [Char]
"  //For certain applications increasing the initial size of the buffer may improve performance.",
      [Char]
"  private static final int INITIAL_BUFFER_SIZE = 128;",
      [Char]
"  private static final int INDENT_WIDTH = 2;",
      [Char]
"  //You may wish to change the parentheses used in precedence.",
      [Char]
"  private static final String _L_PAREN = new String(\"(\");",
      [Char]
"  private static final String _R_PAREN = new String(\")\");",
      [Char]
prRender
      ]
    footer :: [Char]
footer = [[Char]] -> [Char]
unlines [ --later only include used categories
      [Char]
"  private static void pp(Integer n, int _i_) { buf_.append(n); buf_.append(\" \"); }",
      [Char]
"  private static void pp(Double d, int _i_) { buf_.append(String.format(java.util.Locale.ROOT, \"%.15g \", d)); }",
      [Char]
"  private static void pp(String s, int _i_) { buf_.append(s); buf_.append(\" \"); }",
      [Char]
"  private static void pp(Character c, int _i_) { buf_.append(\"'\" + c.toString() + \"'\"); buf_.append(\" \"); }",
      [Char]
"  private static void sh(Integer n) { render(n.toString()); }",
      [Char]
"  private static void sh(Double d) { render(String.format(java.util.Locale.ROOT, \"%.15g\", d)); }",
      [Char]
"  private static void sh(Character c) { render(\"'\" + c.toString() + \"'\"); }",
      [Char]
"  private static void sh(String s) { printQuoted(s); }",
      [Char]
"",
      [Char]
"  private static void printQuoted(String s) { render(\"\\\"\" + s + \"\\\"\"); }",
      [Char]
"",
      [Char]
"  private static void indent()",
      [Char]
"  {",
      [Char]
"    int n = _n_;",
      [Char]
"    while (n > 0)",
      [Char]
"    {",
      [Char]
"      buf_.append(\' \');",
      [Char]
"      n--;",
      [Char]
"    }",
      [Char]
"  }",
      [Char]
"",
      [Char]
"  private static void backup()",
      [Char]
"  {",
      [Char]
"    int prev = buf_.length() - 1;",
      [Char]
"    if (prev >= 0 && buf_.charAt(prev) == ' ')",
      [Char]
"      buf_.setLength(prev);",
      [Char]
"  }",
      [Char]
"",
      [Char]
"  private static void trim()",
      [Char]
"  {",
      [Char]
"    // Trim initial spaces",
      [Char]
"    int end = 0;",
      [Char]
"    int len = buf_.length();",
      [Char]
"    while (end < len && buf_.charAt(end) == ' ')",
      [Char]
"      end++; ",
      [Char]
"    buf_.delete(0, end);",
      [Char]
"    // Trim trailing spaces",
      [Char]
"    removeTrailingSpaces();",
      [Char]
"  }",
      [Char]
"",
      [Char]
"  private static void removeTrailingSpaces()",
      [Char]
"  {",
      [Char]
"    int end = buf_.length();",
      [Char]
"    while (end > 0 && buf_.charAt(end-1) == ' ')",
      [Char]
"      end--;",
      [Char]
"    buf_.setLength(end);",
      [Char]
"  }",
      [Char]
"",
      [Char]
"  private static void removeTrailingWhitespace()",
      [Char]
"  {",
      [Char]
"    int end = buf_.length();",
      [Char]
"    while (end > 0 && (buf_.charAt(end-1) == ' ' || buf_.charAt(end-1) == '\\n'))",
      [Char]
"      end--;",
      [Char]
"    buf_.setLength(end);",
      [Char]
"  }",
      [Char]
"",
      [Char]
"  private static void onEmptyLine()",
      [Char]
"  {",
      [Char]
"    removeTrailingSpaces();",
      [Char]
"    int len = buf_.length();",
      [Char]
"    if (len > 0 && buf_.charAt(len-1) != '\\n') buf_.append(\"\\n\");",
      [Char]
"    indent();",
      [Char]
"  }",
      [Char]
"",
      [Char]
"  private static int _n_ = 0;",
      [Char]
"  private static StringBuilder buf_ = new StringBuilder(INITIAL_BUFFER_SIZE);",
      [Char]
"}"
      ]

--An extremely simple renderer for terminals.
prRender :: String
prRender :: [Char]
prRender = [[Char]] -> [Char]
unlines
  [
      [Char]
"  //You may wish to change render",
      [Char]
"  private static void render(String s)",
      [Char]
"  {",
      [Char]
"    if (s.equals(\"{\"))",
      [Char]
"    {",
      [Char]
"       onEmptyLine();",
      [Char]
"       buf_.append(s);",
      [Char]
"       _n_ = _n_ + INDENT_WIDTH;",
      [Char]
"       buf_.append(\"\\n\");",
      [Char]
"       indent();",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\"(\") || s.equals(\"[\"))",
      [Char]
"       buf_.append(s);",
      [Char]
"    else if (s.equals(\")\") || s.equals(\"]\"))",
      [Char]
"    {",
      [Char]
"       removeTrailingWhitespace();",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\" \");",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\"}\"))",
      [Char]
"    {",
      [Char]
"       _n_ = _n_ - INDENT_WIDTH;",
      [Char]
"       onEmptyLine();",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\"\\n\");",
      [Char]
"       indent();",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\",\"))",
      [Char]
"    {",
      [Char]
"       removeTrailingWhitespace();",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\" \");",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\";\"))",
      [Char]
"    {",
      [Char]
"       removeTrailingWhitespace();",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\"\\n\");",
      [Char]
"       indent();",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\"\")) return;",
      [Char]
"    else if (s.trim().equals(\"\"))",
      [Char]
"    {",
      [Char]
"       backup();",
      [Char]
"       buf_.append(s);",
      [Char]
"    }",
      [Char]
"    else",
      [Char]
"    {",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\" \");",
      [Char]
"    }",
      [Char]
"  }"
  ]

prEntryPoints :: String -> CF -> String
prEntryPoints :: [Char] -> CF -> [Char]
prEntryPoints [Char]
packageAbsyn CF
cf =
    [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Cat -> [Char]) -> [Cat] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> [Char]
prEntryPoint (CF -> [Cat]
allCatsNorm CF
cf) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg2
 where
  msg :: [Char]
msg = [Char]
"  //  print and show methods are defined for each category.\n"
  msg2 :: [Char]
msg2 = [Char]
"  /***   You shouldn't need to change anything beyond this point.   ***/\n"
  prEntryPoint :: Cat -> [Char]
prEntryPoint Cat
cat = [[Char]] -> [Char]
unlines
   [
    [Char]
"  public static String print(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cat' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" foo)",
    [Char]
"  {",
    [Char]
"    pp(foo, 0);",
    [Char]
"    trim();",
    [Char]
"    String temp = buf_.toString();",
    [Char]
"    buf_.delete(0,buf_.length());",
    [Char]
"    return temp;",
    [Char]
"  }",
    [Char]
"  public static String show(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cat' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" foo)",
    [Char]
"  {",
    [Char]
"    sh(foo);",
    [Char]
"    String temp = buf_.toString();",
    [Char]
"    buf_.delete(0,buf_.length());",
    [Char]
"    return temp;",
    [Char]
"  }"
   ]
   where
    cat' :: [Char]
cat' = Cat -> [Char]
identCat Cat
cat

prData :: String ->  [UserDef] -> (Cat, [Rule]) -> String
prData :: [Char] -> [[Char]] -> (Cat, [Rule]) -> [Char]
prData [Char]
packageAbsyn [[Char]]
user (Cat
cat, [Rule]
rules)
  | Cat -> Bool
isList Cat
cat = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ [Char]
"  private static void pp(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" foo, int _i_)"
        , [Char]
"  {"
        , [Char]
"    pp" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(foo.iterator(), _i_);"
        , [Char]
"  }"
        , [Char]
""
        , [Char]
"  private static void pp" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(java.util.Iterator<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
et [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"> it, int _i_)"
        , [Char]
"  {"
        ]
      , ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"    " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Rule] -> [[Char]]
prList [Char]
dat [Char]
et [Rule]
rules
      , [ [Char]
"  }"
        , [Char]
""
        ]
      ]
  | Bool
otherwise = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
      [ [Char]
"  private static void pp(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dat [Char] -> [Char] -> [Char]
+++ [Char]
"foo, int _i_)"
      , [Char]
"  {"
      , [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
addElse ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Rule -> [Char]) -> [Rule] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Rule -> [Char]
prRule [Char]
packageAbsyn) [Rule]
rules)
      , [Char]
"  }"
      ]
  where
  dat :: [Char]
dat = Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
cat)
  et :: [Char]
et  = [Char] -> [[Char]] -> [Char] -> [Char]
typename [Char]
packageAbsyn [[Char]]
user ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> [Char]
identCat (Cat -> [Char]) -> Cat -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCatOfList Cat
cat
  addElse :: [[Char]] -> [[Char]]
addElse = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"    " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
"else " ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
    ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace)


prRule :: String -> Rule -> String
prRule :: [Char] -> Rule -> [Char]
prRule [Char]
packageAbsyn r :: Rule
r@(Rule RFun
f RCat
_c SentForm
cats InternalRule
_) | Bool -> Bool
not (RFun -> Bool
forall a. IsFun a => a -> Bool
isCoercion RFun
f Bool -> Bool -> Bool
|| RFun -> Bool
forall a. IsFun a => a -> Bool
isDefinedRule RFun
f) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Char]
"    if (foo instanceof" [Char] -> [Char] -> [Char]
+++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fun [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")\n"
    , [Char]
"    {\n"
    , [Char]
"       " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fun [Char] -> [Char] -> [Char]
+++ [Char]
fnm [Char] -> [Char] -> [Char]
+++ [Char]
"= ("
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fun [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") foo;\n"
    , [Char]
lparen
    , [Char]
cats'
    , [Char]
rparen
    , [Char]
"    }\n"
    ]
  where
    fun :: [Char]
fun = RFun -> [Char]
forall a. IsFun a => a -> [Char]
funName RFun
f
    p :: Integer
p = Rule -> Integer
forall f. Rul f -> Integer
precRule Rule
r
    ([Char]
lparen, [Char]
rparen) =
        ([Char]
"       if (_i_ > " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") render(_L_PAREN);\n",
        [Char]
"       if (_i_ > " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") render(_R_PAREN);\n")
    cats' :: [Char]
cats' = case SentForm
cats of
        [] -> [Char]
""
        SentForm
_  -> (Either (Cat, Doc) [Char] -> [Char])
-> [Either (Cat, Doc) [Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Doc -> [Char]
render (Doc -> [Char])
-> (Either (Cat, Doc) [Char] -> Doc)
-> Either (Cat, Doc) [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Either (Cat, Doc) [Char] -> Doc
prItem ([Char] -> Doc
text [Char]
fnm)) (SentForm -> [Either (Cat, Doc) [Char]]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats)
    fnm :: [Char]
fnm = Char
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fun

prRule [Char]
_nm Rule
_ = [Char]
""

prList :: String -> String -> [Rule] -> [String]
prList :: [Char] -> [Char] -> [Rule] -> [[Char]]
prList [Char]
dat [Char]
et [Rule]
rules = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs0 then
      [ [Char]
"if (it.hasNext())" ]
      else
      [ [Char]
"if (!it.hasNext())"
      , [Char]
"{ /* nil */"
      , Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
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]
docs0
      , [Char]
"}"
      , [Char]
"else"
      ]
    , if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs1 then
      [ [Char]
"{ /* cons */"
      , [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
et [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" el = it.next();"
      ]
      else
      [ [Char]
"{"
      , [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
et [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" el = it.next();"
      , [Char]
"  if (!it.hasNext())"
      , [Char]
"  { /* last */"
      , Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
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]
docs1
      , [Char]
"  }"
      , [Char]
"  else"
      , [Char]
"  { /* cons */"
      ]
    , [Doc] -> ([Doc] -> [[Char]]) -> [[Char]]
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] -> [[Char]]) -> [[Char]])
-> ([Doc] -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \ [Doc]
docs ->
      [ Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest (if [Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs1 then Int
2 else Int
4) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
docs
      ]
    , Bool -> [[Char]] -> [[Char]]
forall m. Monoid m => Bool -> m -> m
unless ([Doc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc]
docs1) [ [Char]
"  }" ]
    , [ [Char]
"}" ]
    ]
  where
  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
. ([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
text ([[Char]] -> [Doc]) -> (Rule -> [[Char]]) -> Rule -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Rule -> [[Char]]
forall a. IsFun a => [Char] -> Rul a -> [[Char]]
prListRule_ [Char]
dat) ([(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

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

prListRule_ :: IsFun a => String -> Rul a -> [String]
prListRule_ :: forall a. IsFun a => [Char] -> Rul a -> [[Char]]
prListRule_ [Char]
dat (Rule a
_ RCat
_ SentForm
items InternalRule
_) = SentForm -> (Either Cat [Char] -> [Char]) -> [[Char]]
forall a b. [a] -> (a -> b) -> [b]
for SentForm
items ((Either Cat [Char] -> [Char]) -> [[Char]])
-> (Either Cat [Char] -> [Char]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \case
  Right [Char]
t                  -> [Char]
"render(\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escapeChars [Char]
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\");"
  Left (TokenCat [Char]
"String") -> [Char]
"printQuoted(el);"
  Left (ListCat Cat
_)         -> [Char]
"pp" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(it, _i_);"
  Left Cat
_                   -> [Char]
"pp(el, _i_);"

-- |
-- >>> prItem "F" (Right "++")
--        render("++");
-- <BLANKLINE>
-- >>> prItem "F" (Left (TokenCat "String", "string_"))
--        printQuoted(F.string_);
-- <BLANKLINE>
-- >>> prItem "F" (Left (Cat "Abc", "abc_"))
--        pp(F.abc_, 0);
-- <BLANKLINE>
prItem :: Doc -> Either (Cat, Doc) String -> Doc
prItem :: Doc -> Either (Cat, Doc) [Char] -> Doc
prItem Doc
_ (Right [Char]
t) = Int -> Doc -> Doc
nest Int
7 (Doc
"render(\"" Doc -> Doc -> Doc
<> [Char] -> Doc
text([Char] -> [Char]
escapeChars [Char]
t) Doc -> Doc -> Doc
<> Doc
"\");\n")
prItem Doc
fnm (Left (TokenCat [Char]
"String", Doc
nt))
    = Int -> Doc -> Doc
nest Int
7 (Doc
"printQuoted(" Doc -> Doc -> Doc
<> Doc
fnm Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
nt Doc -> Doc -> Doc
<> Doc
");\n")
prItem Doc
fnm (Left (Cat
cat, Doc
nt))
    = Int -> Doc -> Doc
nest Int
7 (Doc
"pp(" Doc -> Doc -> Doc
<> Doc
fnm Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
nt Doc -> Doc -> Doc
<> Doc
", " Doc -> Doc -> Doc
<> Integer -> Doc
integer (Cat -> Integer
precCat Cat
cat) Doc -> Doc -> Doc
<> Doc
");\n")

--The following methods generate the Show function.

shData :: String -> [UserDef] -> (Cat, [Rule]) -> String
shData :: [Char] -> [[Char]] -> (Cat, [Rule]) -> [Char]
shData [Char]
packageAbsyn [[Char]]
user (Cat
cat, [Rule]
rules) = [[Char]] -> [Char]
unlines [[Char]]
k
    where
      k :: [[Char]]
k = if Cat -> Bool
isList Cat
cat
          then
          [ [Char]
"  private static void sh(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
cat) [Char] -> [Char] -> [Char]
+++ [Char]
"foo)"
          , [Char]
"  {"
          , [Char] -> [[Char]] -> Cat -> [Rule] -> [Char]
shList [Char]
packageAbsyn [[Char]]
user Cat
cat [Rule]
rules [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  }"
          ]
          else
          [ [Char]
"  private static void sh(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
cat) [Char] -> [Char] -> [Char]
+++ [Char]
"foo)"
          , [Char]
"  {"
          , (Rule -> [Char]) -> [Rule] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> Rule -> [Char]
shRule [Char]
packageAbsyn) [Rule]
rules [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  }"
          ]


shRule :: String -> Rule -> String
shRule :: [Char] -> Rule -> [Char]
shRule [Char]
packageAbsyn (Rule RFun
f RCat
_c SentForm
cats InternalRule
_) | Bool -> Bool
not (RFun -> Bool
forall a. IsFun a => a -> Bool
isCoercion RFun
f Bool -> Bool -> Bool
|| RFun -> Bool
forall a. IsFun a => a -> Bool
isDefinedRule RFun
f) = [[Char]] -> [Char]
unlines
    [ [Char]
"    if (foo instanceof" [Char] -> [Char] -> [Char]
+++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fun [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
    , [Char]
"    {"
    , [Char]
"       " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fun [Char] -> [Char] -> [Char]
+++ [Char]
fnm [Char] -> [Char] -> [Char]
+++ [Char]
"= ("
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fun [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") foo;"
    , [Char]
members [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    }"
    ]
  where
    fun :: [Char]
fun = RFun -> [Char]
forall a. IsFun a => a -> [Char]
funName RFun
f
    members :: [Char]
members = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Char]
lparen
                     , [Char]
"       render(\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escapeChars [Char]
fun [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\");\n"
                     , [Char]
cats'
                     , [Char]
rparen ]
    cats' :: [Char]
cats' = if SentForm -> Bool
forall {a} {b}. [Either a b] -> Bool
allTerms SentForm
cats
        then [Char]
""
        else ((Cat, Doc) -> [Char]) -> [(Cat, Doc)] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Doc -> [Char]
render (Doc -> [Char]) -> ((Cat, Doc) -> Doc) -> (Cat, Doc) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> (Cat, Doc) -> Doc
shCat ([Char] -> Doc
text [Char]
fnm)) ([Either (Cat, Doc) [Char]] -> [(Cat, Doc)]
forall a b. [Either a b] -> [a]
lefts (SentForm -> [Either (Cat, Doc) [Char]]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats))
    ([Char]
lparen, [Char]
rparen) = if SentForm -> Bool
forall {a} {b}. [Either a b] -> Bool
allTerms SentForm
cats
        then ([Char]
"",[Char]
"")
        else ([Char]
"       render(\"(\");\n",[Char]
"       render(\")\");\n")
    allTerms :: [Either a b] -> Bool
allTerms [] = Bool
True
    allTerms ((Left {}):[Either a b]
_) = Bool
False
    allTerms (Either a b
_:[Either a b]
zs) = [Either a b] -> Bool
allTerms [Either a b]
zs
    fnm :: [Char]
fnm = Char
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fun
shRule [Char]
_nm Rule
_ = [Char]
""

shList :: String -> [UserDef] -> Cat -> [Rule] -> String
shList :: [Char] -> [[Char]] -> Cat -> [Rule] -> [Char]
shList [Char]
packageAbsyn [[Char]]
user Cat
c [Rule]
_rules = [[Char]] -> [Char]
unlines
  [
   [Char]
"     for (java.util.Iterator<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
et
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"> it = foo.iterator(); it.hasNext();)",
   [Char]
"     {",
   [Char]
"       sh(it.next());",
   [Char]
"       if (it.hasNext())",
   [Char]
"         render(\",\");",
   [Char]
"     }"
  ]
    where
    et :: [Char]
et = [Char] -> [[Char]] -> [Char] -> [Char]
typename [Char]
packageAbsyn [[Char]]
user ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> [Char]
identCat (Cat -> [Char]) -> Cat -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCatOfList Cat
c

-- |
-- >>> shCat "F" (ListCat (Cat "A"), "lista_")
--        render("[");
--        sh(F.lista_);
--        render("]");
-- <BLANKLINE>
-- >>> shCat "F" (Cat "A", "a_")
--        sh(F.a_);
-- <BLANKLINE>
shCat :: Doc -> (Cat, Doc) -> Doc
shCat :: Doc -> (Cat, Doc) -> Doc
shCat Doc
fnm (ListCat Cat
_, Doc
vname) = [Doc] -> Doc
vcat
    [ Doc
"       render(\"[\");"
    , Doc
"       sh(" Doc -> Doc -> Doc
<> Doc
fnm Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
");"
    , Doc
"       render(\"]\");\n" ]
shCat Doc
fname (Cat
_, Doc
vname)       = Doc
"       sh(" Doc -> Doc -> Doc
<> Doc
fname Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
vname Doc -> Doc -> Doc
<> Doc
");\n"

--Helper function that escapes characters in strings
escapeChars :: String -> String
escapeChars :: [Char] -> [Char]
escapeChars [] = []
escapeChars (Char
'\\':[Char]
xs) = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escapeChars [Char]
xs
escapeChars (Char
'\"':[Char]
xs) = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'\"' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escapeChars [Char]
xs
escapeChars (Char
x:[Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escapeChars [Char]
xs