{-# 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 Data.Bifunctor  ( first )
import Data.Char       ( isUpper, toLower )
import Data.Function   ( on )
import Data.List       ( findIndices, intercalate )
import Data.Maybe      ( mapMaybe )
import System.FilePath ( (</>) )
import Text.PrettyPrint as P

import BNFC.CF
import BNFC.Options     ( RecordPositions(..) )
import BNFC.TypeChecker ( buildContext, ctxTokens, isToken )
import BNFC.Utils       ( (+++), (++++), unless )

import BNFC.Backend.Common.NamedVariables ( UserDef, showNum )
import BNFC.Backend.Java.Utils            ( getRuleName )

--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 (without file extension)
--   which must be written to disk.
--   The tuple is (FileName, FileContents)

cf2JavaAbs :: FilePath  -- ^ Directory for AST without trailing 'pathSeparator'.
  -> String -> String -> CF -> RecordPositions -> [(FilePath, String)]
cf2JavaAbs :: FilePath
-> FilePath
-> FilePath
-> CF
-> RecordPositions
-> [(FilePath, FilePath)]
cf2JavaAbs FilePath
dirAbsyn FilePath
packageBase FilePath
packageAbsyn CF
cf RecordPositions
rp = [[(FilePath, FilePath)]] -> [(FilePath, FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ Bool -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall m. Monoid m => Bool -> m -> m
unless ([Define] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Define]
defs)
    [ (FilePath
dirAbsyn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"Def", [FilePath] -> FilePath
unlines [FilePath]
deftext) ]
  , ((FilePath, FilePath) -> (FilePath, FilePath))
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath)
-> (FilePath, FilePath) -> (FilePath, FilePath)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FilePath -> FilePath
mkPath) ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (Data -> [(FilePath, FilePath)])
-> [Data] -> [(FilePath, FilePath)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RecordPositions
-> FilePath
-> FilePath
-> [FilePath]
-> Data
-> [(FilePath, FilePath)]
prData RecordPositions
rp FilePath
header FilePath
packageAbsyn [FilePath]
user) [Data]
rules
  ]
  where
  header :: FilePath
header = FilePath
"package " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
packageAbsyn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";\n"
  user :: [FilePath]
user   = [ FilePath
n | (FilePath
n,Reg
_) <- CF -> [(FilePath, Reg)]
forall f. CFG f -> [(FilePath, Reg)]
tokenPragmas CF
cf ]
  rules :: [Data]
rules  = CF -> [Data]
getAbstractSyntax CF
cf
  defs :: [Define]
defs   = CF -> [Define]
forall f. CFG f -> [Define]
definitions CF
cf
  deftext :: [FilePath]
deftext= [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
   [ [ FilePath
"package " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
packageBase FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";"
     , FilePath
""
     , FilePath
"public class AbsynDef {"
     , FilePath
""
     , FilePath
"  public static <B,A extends java.util.LinkedList<? super B>> A cons(B x, A xs) {"
     , FilePath
"    xs.addFirst(x);"
     , FilePath
"    return xs;"
     , FilePath
"  }"
     , FilePath
""
     ]
   , [Define] -> FilePath -> CF -> [FilePath]
definedRules [Define]
defs FilePath
packageAbsyn CF
cf
   , [ FilePath
"}"]
   ]
  mkPath :: String -> FilePath
  mkPath :: FilePath -> FilePath
mkPath FilePath
s = FilePath
dirAbsyn FilePath -> FilePath -> FilePath
</> FilePath
s

definedRules :: [Define] -> String -> CF -> [String]
definedRules :: [Define] -> FilePath -> CF -> [FilePath]
definedRules [Define]
defs FilePath
packageAbsyn CF
cf = (Define -> FilePath) -> [Define] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Define -> FilePath
rule [Define]
defs
  where
    ctx :: Context
ctx = CF -> Context
buildContext CF
cf

    rule :: Define -> FilePath
rule (Define RFun
f Telescope
args Exp
e Base
t) =
        [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
                [ FilePath
"public static " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Base -> FilePath
javaType Base
t FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
sanitize (RFun -> FilePath
forall a. IsFun a => a -> FilePath
funName RFun
f) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                    FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (((FilePath, Base) -> FilePath) -> Telescope -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Base) -> FilePath
javaArg Telescope
args) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
") {"
                , FilePath
"  return " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> Exp -> FilePath
javaExp (((FilePath, Base) -> FilePath) -> Telescope -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Base) -> FilePath
forall a b. (a, b) -> a
fst Telescope
args) Exp
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";"
                , FilePath
"}"
                ]
     where
       sanitize :: FilePath -> FilePath
sanitize = FilePath -> FilePath
getRuleName

       javaType :: Base -> String
       javaType :: Base -> FilePath
javaType = \case
           ListT (BaseT FilePath
x) -> [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ FilePath
packageAbsyn, FilePath
".List", FilePath
x ]
           BaseT FilePath
x         -> FilePath -> [FilePath] -> FilePath -> FilePath
typename FilePath
packageAbsyn (Context -> [FilePath]
ctxTokens Context
ctx) FilePath
x
           ListT ListT{}   -> FilePath
forall a. HasCallStack => a
undefined
           -- ListT t         -> javaType t -- undefined

       javaArg :: (String, Base) -> String
       javaArg :: (FilePath, Base) -> FilePath
javaArg (FilePath
x,Base
t) = Base -> FilePath
javaType Base
t FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x

       javaExp :: [String] -> Exp -> String
       javaExp :: [FilePath] -> Exp -> FilePath
javaExp [FilePath]
args = \case
           Var FilePath
x                -> FilePath
x      -- argument
           App FilePath
"[]" (FunT [Base]
_ Base
t) []
                                -> FilePath -> [Exp] -> FilePath
callQ (Base -> FilePath
identType Base
t) []
           App FilePath
"(:)" Type
_ [Exp]
es       -> FilePath -> [Exp] -> FilePath
call FilePath
"cons" [Exp]
es
           App FilePath
t Type
_ [Exp
e]
             | FilePath -> Context -> Bool
isToken FilePath
t Context
ctx    -> [FilePath] -> Exp -> FilePath
javaExp [FilePath]
args Exp
e     -- wraps new String
           App FilePath
x Type
_ [Exp]
es
             | Char -> Bool
isUpper (FilePath -> Char
forall a. [a] -> a
head FilePath
x) -> FilePath -> [Exp] -> FilePath
callQ FilePath
x [Exp]
es
             | Bool
otherwise        -> FilePath -> [Exp] -> FilePath
call (FilePath -> FilePath
sanitize FilePath
x) [Exp]
es
            -- -- | x `elem` args    -> call x es
           LitInt Integer
n             -> FilePath
"Integer.valueOf(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
           LitDouble Double
x          -> FilePath
"Double.valueOf(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Double -> FilePath
forall a. Show a => a -> FilePath
show Double
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
           LitChar Char
c            -> FilePath
"Character.valueOf(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char -> FilePath
forall a. Show a => a -> FilePath
show Char
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
           LitString FilePath
s          -> FilePath
"String.valueOf(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
         where
         call :: FilePath -> [Exp] -> FilePath
call FilePath
x [Exp]
es = FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((Exp -> FilePath) -> [Exp] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> Exp -> FilePath
javaExp [FilePath]
args) [Exp]
es) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
         callQ :: FilePath -> [Exp] -> FilePath
callQ     = FilePath -> [Exp] -> FilePath
call (FilePath -> [Exp] -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> [Exp] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
qualify
         qualify :: FilePath -> FilePath
qualify FilePath
x = FilePath
"new " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
packageAbsyn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x


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

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

prVisitor :: String -> [String] -> String
prVisitor :: FilePath -> [FilePath] -> FilePath
prVisitor FilePath
packageAbsyn [FilePath]
funs =
    [FilePath] -> FilePath
unlines [
             FilePath
"  public interface Visitor <R,A> {",
             [FilePath] -> FilePath
unlines ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
prVisitFun [FilePath]
funs),
             FilePath
"  }"
            ]
    where
    prVisitFun :: FilePath -> FilePath
prVisitFun FilePath
f = FilePath
"    public R visit(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
packageAbsyn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" 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
-> FilePath
-> FilePath
-> [FilePath]
-> [FilePath]
-> Cat
-> (FilePath, [Cat])
-> Maybe (FilePath, FilePath)
prRule RecordPositions
rp FilePath
h FilePath
packageAbsyn [FilePath]
funs [FilePath]
user Cat
c (FilePath
fun, [Cat]
cats)
  | FilePath -> Bool
forall a. IsFun a => a -> Bool
isNilFun FilePath
fun Bool -> Bool -> Bool
|| FilePath -> Bool
forall a. IsFun a => a -> Bool
isOneFun FilePath
fun = Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing  -- these are not represented in the Absyn
  | FilePath -> Bool
forall a. IsFun a => a -> Bool
isConsFun FilePath
fun = (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just ((FilePath, FilePath) -> Maybe (FilePath, FilePath))
-> ([FilePath] -> (FilePath, FilePath))
-> [FilePath]
-> Maybe (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
fun',) (FilePath -> (FilePath, FilePath))
-> ([FilePath] -> FilePath) -> [FilePath] -> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> Maybe (FilePath, FilePath))
-> [FilePath] -> Maybe (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ -- this is the linked list case.
      [ FilePath
h
      , [FilePath] -> FilePath
unwords [ FilePath
"public class", FilePath
fun', FilePath
"extends", [FilePath] -> Cat -> FilePath
cat2JavaTypeTopList [FilePath]
user Cat
c, FilePath
"{" ]
      , FilePath
"}"
      ]
  | Bool
otherwise = (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just ((FilePath, FilePath) -> Maybe (FilePath, FilePath))
-> ([FilePath] -> (FilePath, FilePath))
-> [FilePath]
-> Maybe (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
fun,) (FilePath -> (FilePath, FilePath))
-> ([FilePath] -> FilePath) -> [FilePath] -> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> Maybe (FilePath, FilePath))
-> [FilePath] -> Maybe (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ -- a standard rule
      [ FilePath
h
      , [FilePath] -> FilePath
unwords [ FilePath
"public class", FilePath
fun, FilePath
ext, FilePath
"{" ]
      , Doc -> FilePath
render (Doc -> FilePath) -> Doc -> FilePath
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
          , FilePath -> [FilePath] -> [IVar] -> [Cat] -> Doc
prConstructor FilePath
fun [FilePath]
user [IVar]
vs [Cat]
cats
          ]
      , FilePath -> Cat -> FilePath -> FilePath
prAccept FilePath
packageAbsyn Cat
c FilePath
fun
      , FilePath -> FilePath -> [IVar] -> FilePath
prEquals FilePath
packageAbsyn FilePath
fun [IVar]
vs
      , FilePath -> FilePath -> [IVar] -> FilePath
prHashCode FilePath
packageAbsyn FilePath
fun [IVar]
vs
      , if Bool
isAlsoCategory then FilePath -> [FilePath] -> FilePath
prVisitor FilePath
packageAbsyn [FilePath]
funs else FilePath
""
      , FilePath
"}"
      ]
   where
     vs :: [IVar]
vs = [Cat] -> [FilePath] -> [IVar]
getVars [Cat]
cats [FilePath]
user
     fun' :: FilePath
fun' = Cat -> FilePath
identCat (Cat -> Cat
normCat Cat
c)
     isAlsoCategory :: Bool
isAlsoCategory = FilePath
fun FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Cat -> FilePath
catToStr Cat
c
     --This handles the case where a LBNF label is the same as the category.
     ext :: FilePath
ext = if Bool
isAlsoCategory then FilePath
"" else FilePath
" extends" FilePath -> FilePath -> FilePath
+++ Cat -> FilePath
identCat Cat
c

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

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

-- | Creates the equals() method.

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

-- | Creates the hashCode() method.

prHashCode :: String -> String -> [IVar] -> String
prHashCode :: FilePath -> FilePath -> [IVar] -> FilePath
prHashCode FilePath
_ FilePath
_ [IVar]
vs =
    [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"  "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath
"public int hashCode() {",
                            FilePath
"  return " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [IVar] -> FilePath
hashKids [IVar]
vs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";",
                            FilePath
"}"
                           ]
  where
  aPrime :: FilePath
aPrime = FilePath
"37"
  hashKids :: [IVar] -> FilePath
hashKids [] = FilePath
aPrime
  hashKids (IVar
v:[IVar]
vs) = FilePath -> [IVar] -> FilePath
hashKids_ (IVar -> FilePath
hashKid IVar
v) [IVar]
vs
  hashKids_ :: FilePath -> [IVar] -> FilePath
hashKids_ = (FilePath -> IVar -> FilePath) -> FilePath -> [IVar] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\FilePath
r IVar
v -> FilePath
aPrime FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"*" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
r FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")+" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IVar -> FilePath
hashKid IVar
v)
  hashKid :: IVar -> FilePath
hashKid IVar
iv = FilePath
"this." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Doc -> FilePath
render (IVar -> Doc
iVarName IVar
iv) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".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@((FilePath
t,Int
_,FilePath
_):[IVar]
_) =
    Doc
"public" Doc -> Doc -> Doc
<+> Doc
"final" Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
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') = FilePath -> [IVar] -> (Doc, [IVar])
prUniques FilePath
t [IVar]
vars
   --these functions group the types together nicely
   prUniques :: String -> [IVar] -> (Doc, [IVar])
   prUniques :: FilePath -> [IVar] -> (Doc, [IVar])
prUniques FilePath
t [IVar]
vs = ([IVar] -> [Int] -> Doc
prVars [IVar]
vs ((IVar -> Bool) -> [IVar] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (\(FilePath
y,Int
_,FilePath
_) ->  FilePath
y FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
t) [IVar]
vs), FilePath -> [IVar] -> [IVar]
remType FilePath
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 :: FilePath -> [IVar] -> [IVar]
remType FilePath
_ [] = []
   remType FilePath
t ((FilePath
t2,Int
n,FilePath
nm):[IVar]
ts)
    | FilePath
t FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
t2 = FilePath -> [IVar] -> [IVar]
remType FilePath
t [IVar]
ts
    | Bool
otherwise = (FilePath
t2,Int
n,FilePath
nm) IVar -> [IVar] -> [IVar]
forall a. a -> [a] -> [a]
: FilePath -> [IVar] -> [IVar]
remType FilePath
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 (FilePath
_,Int
n,FilePath
nm) = FilePath -> Doc
text (FilePath -> FilePath
varName FilePath
nm) Doc -> Doc -> Doc
P.<> FilePath -> Doc
text (Int -> FilePath
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 :: FilePath -> [FilePath] -> [IVar] -> [Cat] -> Doc
prConstructor FilePath
c [FilePath]
u [IVar]
vs [Cat]
cats =
    Doc
"public" Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
c Doc -> Doc -> Doc
P.<> Doc -> Doc
parens ([FilePath] -> [FilePath] -> Doc
interleave [FilePath]
types [FilePath]
params)
    Doc -> Doc -> Doc
<+> Doc
"{" Doc -> Doc -> Doc
<+> FilePath -> Doc
text ([IVar] -> [FilePath] -> FilePath
prAssigns [IVar]
vs [FilePath]
params) Doc -> Doc -> Doc
P.<> Doc
"}"
  where
   ([FilePath]
types, [FilePath]
params) = [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip ([Cat] -> [FilePath] -> Int -> Int -> [(FilePath, FilePath)]
prParams [Cat]
cats [FilePath]
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 :: [FilePath] -> [FilePath] -> Doc
interleave [FilePath]
xs [FilePath]
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
$ (FilePath -> FilePath -> Doc) -> [FilePath] -> [FilePath] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc)
-> (FilePath -> Doc) -> FilePath -> FilePath -> Doc
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FilePath -> Doc
text) [FilePath]
xs [FilePath]
ys

-- | Prints the parameters to the constructors.

prParams :: [Cat] -> [UserDef] -> Int -> Int -> [(String,String)]
prParams :: [Cat] -> [FilePath] -> Int -> Int -> [(FilePath, FilePath)]
prParams [Cat]
cs [FilePath]
user Int
n Int
m = (Cat -> Int -> (FilePath, FilePath))
-> [Cat] -> [Int] -> [(FilePath, FilePath)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Cat -> Int -> (FilePath, FilePath)
forall a. Show a => Cat -> a -> (FilePath, FilePath)
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 -> (FilePath, FilePath)
pr Cat
c a
k = (FilePath -> [FilePath] -> FilePath -> FilePath
typename FilePath
"" [FilePath]
user (Cat -> FilePath
identCat Cat
c), Char
'p' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: a -> FilePath
forall a. Show a => a -> FilePath
show a
k)

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

prAssigns :: [IVar] -> [String] -> String
prAssigns :: [IVar] -> [FilePath] -> FilePath
prAssigns [] [FilePath]
_ = []
prAssigns [IVar]
_ [] = []
prAssigns ((FilePath
t,Int
n,FilePath
nm):[IVar]
vs) (FilePath
p:[FilePath]
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 (FilePath
l,Int
_,FilePath
_) -> FilePath
l FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
t) [IVar]
vs of
    [] -> FilePath -> FilePath
varName FilePath
nm FilePath -> FilePath -> FilePath
+++ FilePath
"=" FilePath -> FilePath -> FilePath
+++ FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";" FilePath -> FilePath -> FilePath
+++ [IVar] -> [FilePath] -> FilePath
prAssigns [IVar]
vs [FilePath]
ps
    [Int]
_ -> FilePath -> FilePath
varName FilePath
nm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
showNum Int
n FilePath -> FilePath -> FilePath
+++ FilePath
"=" FilePath -> FilePath -> FilePath
+++ FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";" FilePath -> FilePath -> FilePath
+++ [IVar] -> [FilePath] -> FilePath
prAssigns [IVar]
vs [FilePath]
ps
 else FilePath -> FilePath
varName FilePath
nm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
showNum Int
n FilePath -> FilePath -> FilePath
+++ FilePath
"=" FilePath -> FilePath -> FilePath
+++ FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";" FilePath -> FilePath -> FilePath
+++ [IVar] -> [FilePath] -> FilePath
prAssigns [IVar]
vs [FilePath]
ps

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

getVars :: [Cat] -> [UserDef] -> [IVar]
getVars :: [Cat] -> [FilePath] -> [IVar]
getVars [Cat]
cs [FilePath]
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] -> FilePath -> [IVar]) -> [IVar] -> [FilePath] -> [IVar]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [IVar] -> FilePath -> [IVar]
forall b.
(Ord b, Num b) =>
[(FilePath, b, FilePath)] -> FilePath -> [(FilePath, b, FilePath)]
addVar [] ((Cat -> FilePath) -> [Cat] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Cat -> FilePath
identCat [Cat]
cs)
  where
  addVar :: [(FilePath, b, FilePath)] -> FilePath -> [(FilePath, b, FilePath)]
addVar [(FilePath, b, FilePath)]
is FilePath
c = (FilePath
c', b
n, FilePath
c)(FilePath, b, FilePath)
-> [(FilePath, b, FilePath)] -> [(FilePath, b, FilePath)]
forall a. a -> [a] -> [a]
:[(FilePath, b, FilePath)]
is
    where c' :: FilePath
c' = FilePath -> [FilePath] -> FilePath -> FilePath
typename FilePath
"" [FilePath]
user FilePath
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 | (FilePath
_,b
n',FilePath
c'') <- [(FilePath, b, FilePath)]
is, FilePath
c'' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
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 :: FilePath -> FilePath
varName FilePath
c = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_"

-- | 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 :: FilePath -> [FilePath] -> FilePath -> FilePath
typename FilePath
q [FilePath]
user FilePath
t
  | FilePath
t FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Ident"   = FilePath
"String"
  | FilePath
t FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Char"    = FilePath
"Character"
  | FilePath
t FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Double"  = FilePath
"Double"
  | FilePath
t FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Integer" = FilePath
"Integer"
  | FilePath
t FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"String"  = FilePath
"String"
  | FilePath
t FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
user  = FilePath
"String"
  | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
q         = FilePath
t
  | Bool
otherwise      = FilePath
q FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
t

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