{-# 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 BNFC.Backend.Java.CFtoJavaAbs15

import BNFC.CF
import BNFC.Backend.Common (renderListSepByPrecedence)
import BNFC.Backend.Common.NamedVariables
import BNFC.Utils ( (+++) )
import Data.List
import Data.Char ( toLower, isSpace )
import Data.Either (lefts)
import BNFC.PrettyPrint

--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]
"  private static void printQuoted(String s) { render(\"\\\"\" + s + \"\\\"\"); }",
      [Char]
"  private static void indent()",
      [Char]
"  {",
      [Char]
"    int n = _n_;",
      [Char]
"    while (n > 0)",
      [Char]
"    {",
      [Char]
"      buf_.append(\' \');",
      [Char]
"      n--;",
      [Char]
"    }",
      [Char]
"  }",
      [Char]
"  private static void backup()",
      [Char]
"  {",
      [Char]
"    int prev = buf_.length() - 1;",
      [Char]
"    if (buf_.charAt(prev) == ' ')",
      [Char]
"      buf_.setLength(prev);",
      [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]
"    end = buf_.length();",
      [Char]
"    while (end > 0 && buf_.charAt(end-1) == ' ')",
      [Char]
"      end--; ",
      [Char]
"    buf_.setLength(end);",
      [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]
"       buf_.append(\"\\n\");",
      [Char]
"       indent();",
      [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]
"       backup();",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\" \");",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\"}\"))",
      [Char]
"    {",
      [Char]
"       int t;",
      [Char]
"       _n_ = _n_ - INDENT_WIDTH;",
      [Char]
"       for(t=0; t<INDENT_WIDTH; t++) {",
      [Char]
"         backup();",
      [Char]
"       }",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\"\\n\");",
      [Char]
"       indent();",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\",\"))",
      [Char]
"    {",
      [Char]
"       backup();",
      [Char]
"       buf_.append(s);",
      [Char]
"       buf_.append(\" \");",
      [Char]
"    }",
      [Char]
"    else if (s.equals(\";\"))",
      [Char]
"    {",
      [Char]
"       backup();",
      [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) = [[Char]] -> [Char]
unlines [[Char]]
k
    where
      k :: [[Char]]
k = if Cat -> Bool
isList Cat
cat
           then
           [[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]
++ Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
cat) [Char] -> [Char] -> [Char]
+++ [Char]
"foo, int _i_)"
            , [Char]
"  {"
            , Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
5 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> Cat -> [Rule] -> Doc
prList [Char]
packageAbsyn [[Char]]
user Cat
cat [Rule]
rules Doc -> Doc -> Doc
<> Doc
"  }"
           ]
           else --not a list
           [
            [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]
++ Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
cat) [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] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  }"
           ]
      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
prCat ([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]
""

-- |
--
-- >>> let lfoo = ListCat (Cat "Foo")
-- >>> prList "absyn" [] lfoo [npRule "[]" lfoo [] Parsable, npRule "(:)" lfoo [Left (Cat "Foo"), Right ".", Left lfoo] Parsable]
-- for (java.util.Iterator<absyn.Foo> it = foo.iterator(); it.hasNext();)
-- {
--   pp(it.next(), _i_);
--   if (it.hasNext()) {
--     render(".");
--   } else {
--     render(".");
--   }
-- }

prList :: String -> [UserDef] -> Cat -> [Rule] -> Doc
prList :: [Char] -> [[Char]] -> Cat -> [Rule] -> Doc
prList [Char]
packageAbsyn [[Char]]
user Cat
c [Rule]
rules =
    Doc
"for (java.util.Iterator<" Doc -> Doc -> Doc
<> Doc
et Doc -> Doc -> Doc
<> Doc
"> it = foo.iterator(); it.hasNext();)"
    Doc -> Doc -> Doc
$$ Int -> [Doc] -> Doc
codeblock Int
2
        [ Doc
"pp(it.next(), _i_);"
        , Doc
"if (it.hasNext()) {"
        , Int -> Doc -> Doc
nest Int
2 (Doc -> ([Char] -> Doc) -> [(Integer, [Char])] -> Doc
renderListSepByPrecedence Doc
"_i_" [Char] -> Doc
renderSep
            ([Rule] -> [(Integer, [Char])]
getSeparatorByPrecedence [Rule]
rules))
        , Doc
"} else {"
        , Int -> Doc -> Doc
nest Int
2 ([Char] -> Doc
renderSep [Char]
optsep Doc -> Doc -> Doc
<> Doc
";")
        , Doc
"}"
        ]
   where
    et :: Doc
et = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [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
    sep :: [Char]
sep = [Char] -> [Char]
escapeChars ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Rule] -> [Char]
getCons [Rule]
rules
    optsep :: [Char]
optsep = if [Rule] -> Bool
hasOneFunc [Rule]
rules then [Char]
"" else [Char]
sep
    renderSep :: [Char] -> Doc
renderSep [Char]
x = Doc
"render(\"" Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
x Doc -> Doc -> Doc
<>Doc
"\")"

-- |
-- >>> prCat "F" (Right "++")
--        render("++");
-- <BLANKLINE>
-- >>> prCat "F" (Left (TokenCat "String", "string_"))
--        printQuoted(F.string_);
-- <BLANKLINE>
-- >>> prCat "F" (Left (Cat "Abc", "abc_"))
--        pp(F.abc_, 0);
-- <BLANKLINE>
prCat :: Doc -> Either (Cat, Doc) String -> Doc
prCat :: Doc -> Either (Cat, Doc) [Char] -> Doc
prCat 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")
prCat 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")
prCat 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