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

{-
    BNF Converter: Java 1.5 Abstract Syntax
    Copyright (C) 2004  Author:  Michael Pellauer, Bjorn Bringert

    Description   : This module generates the Java Abstract Syntax
                    It uses the BNFC.Backend.Common.NamedVariables module for variable
                    naming. It returns a list of file names, and the
                    contents to be written into that file. (In Java
                    public classes must go in their own file.)

                    The generated classes also support the Visitor
                    Design Pattern.

    Author        : Michael Pellauer
                    Bjorn Bringert
    Created       : 24 April, 2003
    Modified      : 16 June, 2004

-}

module BNFC.Backend.Java.CFtoJavaAbs15 (cf2JavaAbs, typename, cat2JavaType) where

import BNFC.CF
import BNFC.Options (RecordPositions(..))
import BNFC.Utils((+++),(++++))
import BNFC.Backend.Common.NamedVariables hiding (IVar, getVars, varName)
import Data.Function (on)
import Data.List
import Data.Char(toLower)
import Data.Maybe (mapMaybe)
import Text.PrettyPrint
import qualified Text.PrettyPrint as P

--Produces abstract data types in Java.
--These follow Appel's "non-object oriented" version.
--They also allow users to use the Visitor design pattern.

type IVar = (String, Int, String)
-- ^ The type of an instance variable,
--   a number unique to that type,
--   and an optional name (handles typedefs).

-- | The result is a list of files which must be written to disk.
--   The tuple is (FileName, FileContents)

cf2JavaAbs :: String -> String -> CF -> RecordPositions -> [(FilePath, String)]
cf2JavaAbs :: String -> String -> CF -> RecordPositions -> [(String, String)]
cf2JavaAbs String
_ String
packageAbsyn CF
cf RecordPositions
rp =
    (Data -> [(String, String)]) -> [Data] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RecordPositions
-> String -> String -> [String] -> Data -> [(String, String)]
prData RecordPositions
rp String
header String
packageAbsyn [String]
user) [Data]
rules
 where
  header :: String
header = String
"package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; // Java Package generated by the BNF Converter.\n"
  user :: [String]
user = [String
n | (String
n,Reg
_) <- CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf]
  rules :: [Data]
rules = CF -> [Data]
getAbstractSyntax CF
cf

-- | Generates a (possibly abstract) category class, and classes for all its rules.

prData :: RecordPositions -> String -> String -> [UserDef] -> Data ->[(String, String)]
prData :: RecordPositions
-> String -> String -> [String] -> Data -> [(String, String)]
prData RecordPositions
rp String
header String
packageAbsyn [String]
user (Cat
cat, [(String, [Cat])]
rules) =
  [(String, String)]
categoryClass [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ ((String, [Cat]) -> Maybe (String, String))
-> [(String, [Cat])] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (RecordPositions
-> String
-> String
-> [String]
-> [String]
-> Cat
-> (String, [Cat])
-> Maybe (String, String)
prRule RecordPositions
rp String
header String
packageAbsyn [String]
funs [String]
user Cat
cat) [(String, [Cat])]
rules
      where
      funs :: [String]
funs = ((String, [Cat]) -> String) -> [(String, [Cat])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Cat]) -> String
forall a b. (a, b) -> a
fst [(String, [Cat])]
rules
      categoryClass :: [(String, String)]
categoryClass
          | Cat -> String
forall a. Show a => a -> String
show Cat
cat String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
funs = [] -- the catgory is also a function, skip abstract class
          | Bool
otherwise = [(Cat -> String
identCat Cat
cat, String
header String -> String -> String
++++
                         [String] -> String
unlines [
                                  String
"public abstract class" String -> String -> String
+++ String
cls
                                    String -> String -> String
+++ String
"implements java.io.Serializable {",
                                  String
"  public abstract <R,A> R accept("
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".Visitor<R,A> v, A arg);",
                                  String -> [String] -> String
prVisitor String
packageAbsyn [String]
funs,
                                  String
"}"
                                 ])]
                where cls :: String
cls = Cat -> String
identCat Cat
cat

prVisitor :: String -> [String] -> String
prVisitor :: String -> [String] -> String
prVisitor String
packageAbsyn [String]
funs =
    [String] -> String
unlines [
             String
"  public interface Visitor <R,A> {",
             [String] -> String
unlines ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
prVisitFun [String]
funs),
             String
"  }"
            ]
    where
    prVisitFun :: String -> String
prVisitFun String
f = String
"    public R visit(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" p, A arg);"

-- | Generates classes for a rule, depending on what type of rule it is.

prRule :: RecordPositions     -- ^ Include line number info in generated classes.
       -> String   -- ^ Header.
       -> String   -- ^ Abstract syntax package name.
       -> [String] -- ^ Names of all constructors in the category.
       -> [UserDef] -> Cat -> (Fun, [Cat]) -> Maybe (String, String)
prRule :: RecordPositions
-> String
-> String
-> [String]
-> [String]
-> Cat
-> (String, [Cat])
-> Maybe (String, String)
prRule RecordPositions
rp String
h String
packageAbsyn [String]
funs [String]
user Cat
c (String
fun, [Cat]
cats)
  | String -> Bool
forall a. IsFun a => a -> Bool
isNilFun String
fun Bool -> Bool -> Bool
|| String -> Bool
forall a. IsFun a => a -> Bool
isOneFun String
fun = Maybe (String, String)
forall a. Maybe a
Nothing  -- these are not represented in the Absyn
  | String -> Bool
forall a. IsFun a => a -> Bool
isConsFun String
fun = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> Maybe (String, String))
-> ([String] -> (String, String))
-> [String]
-> Maybe (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
fun',) (String -> (String, String))
-> ([String] -> String) -> [String] -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Maybe (String, String))
-> [String] -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ -- this is the linked list case.
      [ String
h
      , [String] -> String
unwords [ String
"public class", String
fun', String
"extends", [String] -> Cat -> String
cat2JavaTypeTopList [String]
user Cat
c, String
"{" ]
      , String
"}"
      ]
  | Bool
otherwise = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> Maybe (String, String))
-> ([String] -> (String, String))
-> [String]
-> Maybe (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
fun,) (String -> (String, String))
-> ([String] -> String) -> [String] -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Maybe (String, String))
-> [String] -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ -- a standard rule
      [ String
h
      , [String] -> String
unwords [ String
"public class", String
fun, String
ext, String
"{" ]
      , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
          [ RecordPositions -> [IVar] -> Doc
prInstVars RecordPositions
rp [IVar]
vs
          , String -> [String] -> [IVar] -> [Cat] -> Doc
prConstructor String
fun [String]
user [IVar]
vs [Cat]
cats
          ]
      , String -> Cat -> String -> String
prAccept String
packageAbsyn Cat
c String
fun
      , String -> String -> [IVar] -> String
prEquals String
packageAbsyn String
fun [IVar]
vs
      , String -> String -> [IVar] -> String
prHashCode String
packageAbsyn String
fun [IVar]
vs
      , if Bool
isAlsoCategory then String -> [String] -> String
prVisitor String
packageAbsyn [String]
funs else String
""
      , String
"}"
      ]
   where
     vs :: [IVar]
vs = [Cat] -> [String] -> [IVar]
getVars [Cat]
cats [String]
user
     fun' :: String
fun' = Cat -> String
identCat (Cat -> Cat
normCat Cat
c)
     isAlsoCategory :: Bool
isAlsoCategory = String
fun String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Cat -> String
forall a. Show a => a -> String
show Cat
c
     --This handles the case where a LBNF label is the same as the category.
     ext :: String
ext = if Bool
isAlsoCategory then String
"" else String
" extends" String -> String -> String
+++ Cat -> String
identCat Cat
c

-- | The standard accept function for the Visitor pattern.

prAccept :: String -> Cat -> String -> String
prAccept :: String -> Cat -> String -> String
prAccept String
pack Cat
cat String
_ = String
"\n  public <R,A> R accept(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pack String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
forall a. Show a => a -> String
show Cat
cat
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".Visitor<R,A> v, A arg) { return v.visit(this, arg); }\n"

-- | Creates the equals() method.

prEquals :: String -> String -> [IVar] -> String
prEquals :: String -> String -> [IVar] -> String
prEquals String
pack String
fun [IVar]
vs =
    [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  "String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String
"public boolean equals(java.lang.Object o) {",
                              String
"  if (this == o) return true;",
                              String
"  if (o instanceof " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fqn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {"]
                              [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (if [IVar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IVar]
vs
                                     then [String
"    return true;"]
                                     else [String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fqn String -> String -> String
+++ String
"x = ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fqnString -> String -> String
forall a. [a] -> [a] -> [a]
++String
")o;",
                                           String
"    return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
checkKids String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                             [String
"  }",
                              String
"  return false;",
                              String
"}"]
  where
  fqn :: String
fqn = String
packString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"."String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fun
  checkKids :: String
checkKids = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" && " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (IVar -> String) -> [IVar] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map IVar -> String
checkKid [IVar]
vs
  checkKid :: IVar -> String
checkKid IVar
iv = String
"this." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".equals(x." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      where v :: String
v = Doc -> String
render (IVar -> Doc
iVarName IVar
iv)

-- | Creates the hashCode() method.

prHashCode :: String -> String -> [IVar] -> String
prHashCode :: String -> String -> [IVar] -> String
prHashCode String
_ String
_ [IVar]
vs =
    [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String
"public int hashCode() {",
                            String
"  return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [IVar] -> String
hashKids [IVar]
vs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";",
                            String
"}"
                           ]
  where
  aPrime :: Integer
aPrime = Integer
37
  hashKids :: [IVar] -> String
hashKids [] = Integer -> String
forall a. Show a => a -> String
show Integer
aPrime
  hashKids (IVar
v:[IVar]
vs) = String -> [IVar] -> String
hashKids_ (IVar -> String
hashKid IVar
v) [IVar]
vs
  hashKids_ :: String -> [IVar] -> String
hashKids_ = (String -> IVar -> String) -> String -> [IVar] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\String
r IVar
v -> Integer -> String
forall a. Show a => a -> String
show Integer
aPrime String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")+" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IVar -> String
hashKid IVar
v)
  hashKid :: IVar -> String
hashKid IVar
iv = String
"this." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
render (IVar -> Doc
iVarName IVar
iv) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".hashCode()"


-- | A class's instance variables.
--
-- >>> prInstVars NoRecordPositions [("A",1,""), ("B",1,""), ("A",2,"abc")]
-- public final A _1, abc_2;
-- public final B _1;
--
-- >>> prInstVars RecordPositions [("A",1,""), ("B",1,""), ("A",2,"abc")]
-- public final A _1, abc_2;
-- public final B _1;
-- public int line_num, col_num, offset;

prInstVars :: RecordPositions -> [IVar] -> Doc
prInstVars :: RecordPositions -> [IVar] -> Doc
prInstVars RecordPositions
rp [] = case RecordPositions
rp of
  RecordPositions
RecordPositions -> Doc
"public int line_num, col_num, offset;"
  RecordPositions
NoRecordPositions -> Doc
empty
prInstVars RecordPositions
rp vars :: [IVar]
vars@((String
t,Int
_,String
_):[IVar]
_) =
    Doc
"public" Doc -> Doc -> Doc
<+> Doc
"final" Doc -> Doc -> Doc
<+> String -> Doc
text String
t Doc -> Doc -> Doc
<+> Doc
uniques Doc -> Doc -> Doc
P.<> Doc
";" Doc -> Doc -> Doc
$$ RecordPositions -> [IVar] -> Doc
prInstVars RecordPositions
rp [IVar]
vs'
 where
   (Doc
uniques, [IVar]
vs') = String -> [IVar] -> (Doc, [IVar])
prUniques String
t [IVar]
vars
   --these functions group the types together nicely
   prUniques :: String -> [IVar] -> (Doc, [IVar])
   prUniques :: String -> [IVar] -> (Doc, [IVar])
prUniques String
t [IVar]
vs = ([IVar] -> [Int] -> Doc
prVars [IVar]
vs ((IVar -> Bool) -> [IVar] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (\(String
y,Int
_,String
_) ->  String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t) [IVar]
vs), String -> [IVar] -> [IVar]
remType String
t [IVar]
vs)
   prVars :: [IVar] -> [Int] -> Doc
prVars [IVar]
vs = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Int] -> [Doc]) -> [Int] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Int] -> [Doc]) -> [Int] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (IVar -> Doc
iVarName (IVar -> Doc) -> (Int -> IVar) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([IVar]
vs[IVar] -> Int -> IVar
forall a. [a] -> Int -> a
!!))
   remType :: String -> [IVar] -> [IVar]
   remType :: String -> [IVar] -> [IVar]
remType String
_ [] = []
   remType String
t ((String
t2,Int
n,String
nm):[IVar]
ts)
    | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t2 = String -> [IVar] -> [IVar]
remType String
t [IVar]
ts
    | Bool
otherwise = (String
t2,Int
n,String
nm) IVar -> [IVar] -> [IVar]
forall a. a -> [a] -> [a]
: String -> [IVar] -> [IVar]
remType String
t [IVar]
ts

-- | Convert IVar to java name.
--
-- >>> iVarName ("A",1,"abc")
-- abc_1
--
-- >>> iVarName ("C", 2, "")
-- _2
--
-- >>> iVarName ("Integer", 0, "integer")
-- integer_

iVarName :: IVar -> Doc
iVarName :: IVar -> Doc
iVarName (String
_,Int
n,String
nm) = String -> Doc
text (String -> String
varName String
nm) Doc -> Doc -> Doc
P.<> String -> Doc
text (Int -> String
forall a. (Eq a, Num a, Show a) => a -> String
showNum Int
n)

-- | The constructor just assigns the parameters to the corresponding instance
-- variables.
--
-- >>> prConstructor "bla" [] [("A",1,"a"),("B",1,""),("A",2,"")] [Cat "A",Cat "B", Cat "C"]
-- public bla(A p1, B p2, C p3) { a_1 = p1; _ = p2; _2 = p3; }
--
-- >>> prConstructor "EInt" [] [("Integer",0,"integer")] [Cat "Integer"]
-- public EInt(Integer p1) { integer_ = p1; }

prConstructor :: String -> [UserDef] -> [IVar] -> [Cat] -> Doc
prConstructor :: String -> [String] -> [IVar] -> [Cat] -> Doc
prConstructor String
c [String]
u [IVar]
vs [Cat]
cats =
    Doc
"public" Doc -> Doc -> Doc
<+> String -> Doc
text String
c Doc -> Doc -> Doc
P.<> Doc -> Doc
parens ([String] -> [String] -> Doc
interleave [String]
types [String]
params)
    Doc -> Doc -> Doc
<+> Doc
"{" Doc -> Doc -> Doc
<+> String -> Doc
text ([IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
params) Doc -> Doc -> Doc
P.<> Doc
"}"
  where
   ([String]
types, [String]
params) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([Cat] -> [String] -> Int -> Int -> [(String, String)]
prParams [Cat]
cats [String]
u ([Cat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cat]
cats) ([Cat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cat]
catsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
   interleave :: [String] -> [String] -> Doc
interleave [String]
xs [String]
ys = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
"," ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (String -> String -> Doc) -> [String] -> [String] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc) -> (String -> Doc) -> String -> String -> Doc
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` String -> Doc
text) [String]
xs [String]
ys

-- | Prints the parameters to the constructors.

prParams :: [Cat] -> [UserDef] -> Int -> Int -> [(String,String)]
prParams :: [Cat] -> [String] -> Int -> Int -> [(String, String)]
prParams [Cat]
cs [String]
user Int
n Int
m = (Cat -> Int -> (String, String))
-> [Cat] -> [Int] -> [(String, String)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Cat -> Int -> (String, String)
forall a. Show a => Cat -> a -> (String, String)
pr [Cat]
cs [Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n, Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 ..]
  where pr :: Cat -> a -> (String, String)
pr Cat
c a
k = (String -> [String] -> String -> String
typename String
"" [String]
user (Cat -> String
identCat Cat
c), Char
'p' Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
k)

-- | This algorithm peeks ahead in the list so we don't use @map@ or @fold@.

prAssigns :: [IVar] -> [String] -> String
prAssigns :: [IVar] -> [String] -> String
prAssigns [] [String]
_ = []
prAssigns [IVar]
_ [] = []
prAssigns ((String
t,Int
n,String
nm):[IVar]
vs) (String
p:[String]
ps) =
 if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then
  case (IVar -> Bool) -> [IVar] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (\IVar
x -> case IVar
x of (String
l,Int
_,String
_) -> String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t) [IVar]
vs of
    [] -> String -> String
varName String
nm String -> String -> String
+++ String
"=" String -> String -> String
+++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
+++ [IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
ps
    [Int]
_ -> String -> String
varName String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Eq a, Num a, Show a) => a -> String
showNum Int
n String -> String -> String
+++ String
"=" String -> String -> String
+++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
+++ [IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
ps
 else String -> String
varName String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Eq a, Num a, Show a) => a -> String
showNum Int
n String -> String -> String
+++ String
"=" String -> String -> String
+++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
+++ [IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
ps

-- | Different than the standard ''BNFC.Backend.Common.NamedVariables'' version
-- because of the user-defined types.

getVars :: [Cat] -> [UserDef] -> [IVar]
getVars :: [Cat] -> [String] -> [IVar]
getVars [Cat]
cs [String]
user = [IVar] -> [IVar]
forall a. [a] -> [a]
reverse ([IVar] -> [IVar]) -> [IVar] -> [IVar]
forall a b. (a -> b) -> a -> b
$ [IVar] -> [IVar]
forall c b a. (Eq c, Num b) => [(a, b, c)] -> [(a, b, c)]
singleToZero ([IVar] -> [IVar]) -> [IVar] -> [IVar]
forall a b. (a -> b) -> a -> b
$ ([IVar] -> String -> [IVar]) -> [IVar] -> [String] -> [IVar]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [IVar] -> String -> [IVar]
forall b.
(Ord b, Num b) =>
[(String, b, String)] -> String -> [(String, b, String)]
addVar [] ((Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Cat -> String
identCat [Cat]
cs)
  where
  addVar :: [(String, b, String)] -> String -> [(String, b, String)]
addVar [(String, b, String)]
is String
c = (String
c', b
n, String
c)(String, b, String)
-> [(String, b, String)] -> [(String, b, String)]
forall a. a -> [a] -> [a]
:[(String, b, String)]
is
    where c' :: String
c' = String -> [String] -> String -> String
typename String
"" [String]
user String
c
          n :: b
n = [b] -> b
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (b
1b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b
n'b -> b -> b
forall a. Num a => a -> a -> a
+b
1 | (String
_,b
n',String
c'') <- [(String, b, String)]
is, String
c'' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
c])
  singleToZero :: [(a, b, c)] -> [(a, b, c)]
singleToZero [(a, b, c)]
is =
    [ (a
t,b
n',c
nm)
    | (a
t,b
n,c
nm) <- [(a, b, c)]
is
    , let n' :: b
n' = if [c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [c
n | (a
_,b
_,c
n) <- [(a, b, c)]
is, c
n c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
nm] Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then b
0 else b
n
    ]

varName :: String -- ^ category name
        -> String -- ^ Variable name
varName :: String -> String
varName String
c = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"

-- | This makes up for the fact that there's no typedef in Java.

typename
  :: String     -- ^ Qualification (can be empty).
  -> [UserDef]  -- ^ User-defined token names.
  -> String     -- ^ Category name.
  -> String
typename :: String -> [String] -> String -> String
typename String
q [String]
user String
t
  | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Ident"   = String
"String"
  | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Char"    = String
"Character"
  | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Double"  = String
"Double"
  | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Integer" = String
"Integer"
  | String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"String"  = String
"String"
  | String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
user  = String
"String"
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
q         = String
t
  | Bool
otherwise      = String
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t

-- | Print the Java type corresponding to a category.
cat2JavaType :: [UserDef] -> Cat -> String
cat2JavaType :: [String] -> Cat -> String
cat2JavaType [String]
user = Cat -> String
loop
  where
  loop :: Cat -> String
loop = \case
    ListCat Cat
c -> String
"List" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
loop Cat
c
    -- ListCat c -> "java.util.LinkedList<" ++ loop c ++ ">"
    Cat
c -> String -> [String] -> String -> String
typename String
"" [String]
user (String -> String) -> String -> String
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

-- | Print the Java type corresponding to a category.
--   The top list is printed as @java.util.LinkedList<...>@.
cat2JavaTypeTopList :: [UserDef] -> Cat -> String
cat2JavaTypeTopList :: [String] -> Cat -> String
cat2JavaTypeTopList [String]
user = \case
  ListCat Cat
c -> String
"java.util.LinkedList<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> Cat -> String
cat2JavaType [String]
user Cat
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
  Cat
c -> [String] -> Cat -> String
cat2JavaType [String]
user Cat
c