{-
    BNF Converter: Java 1.5 Fold Vistor generator
    Copyright (C) 2006 Bjorn Bringert
    Based on CFtoVisitSkel.hs, Copyright (C) 2004-2006  Michael Pellauer

-}

{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.Java.CFtoFoldVisitor (cf2FoldVisitor) where

import Prelude hiding ((<>))

import BNFC.CF
import BNFC.Backend.Java.CFtoJavaAbs15 (typename)
import BNFC.Utils ((+++))
import BNFC.Backend.Common.NamedVariables
import Data.Either (lefts)
import BNFC.PrettyPrint

cf2FoldVisitor :: String -> String -> CF -> String
cf2FoldVisitor :: String -> String -> CF -> String
cf2FoldVisitor String
packageBase String
packageAbsyn CF
cf =
  [String] -> String
unlines
    [String
"package" String -> String -> String
+++ String
packageBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";",
     String
"",
     String
"/** BNFC-Generated Fold Visitor */",
     String
"public abstract class FoldVisitor<R,A> implements AllVisitor<R,A> {",
     String
"    public abstract R leaf(A arg);",
     String
"    public abstract R combine(R x, R y, A arg);",
     String
"",
     ((Cat, [Rule]) -> String) -> [(Cat, [Rule])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> [String] -> (Cat, [Rule]) -> String
prData String
packageAbsyn [String]
user) [(Cat, [Rule])]
groups,
     String
"}"]
  where
    user :: [String]
user = ([String], [Reg]) -> [String]
forall a b. (a, b) -> a
fst ([(String, Reg)] -> ([String], [Reg])
forall a b. [(a, b)] -> ([a], [b])
unzip (CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf))
    groups :: [(Cat, [Rule])]
groups = [ (Cat, [Rule])
g | g :: (Cat, [Rule])
g@(Cat
c,[Rule]
_) <- [(Cat, [Rule])] -> [(Cat, [Rule])]
fixCoercions (CF -> [(Cat, [Rule])]
ruleGroupsInternals CF
cf), Bool -> Bool
not (Cat -> Bool
isList Cat
c) ]

--Traverses a category based on its type.
prData :: String -> [UserDef] -> (Cat, [Rule]) -> String
prData :: String -> [String] -> (Cat, [Rule]) -> String
prData String
packageAbsyn [String]
user (Cat
cat, [Rule]
rules) = [String] -> String
unlines
    [ String
"/* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
cat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" */"
    , (Rule -> String) -> [Rule] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> [String] -> Cat -> Rule -> String
prRule String
packageAbsyn [String]
user Cat
cat) [Rule]
rules
    ]

--traverses a standard rule.
prRule :: String -> [UserDef] -> Cat -> Rule -> String
prRule :: String -> [String] -> Cat -> Rule -> String
prRule String
packageAbsyn [String]
user Cat
_ (Rule RFun
fun RCat
_ SentForm
cats InternalRule
_)
    | Bool -> Bool
not (RFun -> Bool
forall a. IsFun a => a -> Bool
isCoercion RFun
fun Bool -> Bool -> Bool
|| RFun -> Bool
forall a. IsFun a => a -> Bool
isDefinedRule RFun
fun) = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  [String
"    public R visit(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" p, A arg) {",
   String
"      R r = leaf(arg);"]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++  (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"      "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
visitVars
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"      return r;",
      String
"    }"]
   where
    cats' :: [(Cat, Doc)]
cats' = [Either (Cat, Doc) String] -> [(Cat, Doc)]
forall a b. [Either a b] -> [a]
lefts ([Either (Cat, Doc) String] -> [(Cat, Doc)])
-> [Either (Cat, Doc) String] -> [(Cat, Doc)]
forall a b. (a -> b) -> a -> b
$ SentForm -> [Either (Cat, Doc) String]
forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats
    cls :: String
cls = String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ RFun -> String
forall a. IsFun a => a -> String
funName RFun
fun
    visitVars :: [String]
visitVars = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Cat, Doc) -> Doc) -> [(Cat, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> (Cat, Doc) -> Doc
prCat String
packageAbsyn [String]
user) [(Cat, Doc)]
cats'
prRule  String
_ [String]
_ Cat
_ Rule
_ = String
""

-- | Traverses a class's instance variables.
-- >>> prCat "" ["A"] (Cat "A", "a_")
-- <BLANKLINE>
-- >>> prCat "" [] (ListCat (Cat "Integer"), "listinteger_")
-- <BLANKLINE>
-- >>> prCat "absyn" [] (ListCat (Cat "N"), "listn_")
-- for (absyn.N x : p.listn_)
-- {
--   r = combine(x.accept(this, arg), r, arg);
-- }
-- >>> prCat "absyn" [] (Cat "N", "n_")
-- r = combine(p.n_.accept(this, arg), r, arg);
prCat :: String     -- ^ Absyn package name.
      -> [UserDef]  -- ^ User-defined token categories.
      -> (Cat, Doc) -- ^ Variable category and name
      -> Doc        -- ^ Code for visiting the variable
prCat :: String -> [String] -> (Cat, Doc) -> Doc
prCat String
packageAbsyn [String]
user (Cat
cat,Doc
nt)
    | [String] -> String -> Bool
isBasicType [String]
user String
varType Bool -> Bool -> Bool
|| (Cat -> Bool
isList Cat
cat Bool -> Bool -> Bool
&& [String] -> String -> Bool
isBasicType [String]
user String
et) = Doc
empty
    | Cat -> Bool
isList Cat
cat = [Doc] -> Doc
vcat
        [ Doc
"for (" Doc -> Doc -> Doc
<> String -> Doc
text String
et Doc -> Doc -> Doc
<> Doc
" x : " Doc -> Doc -> Doc
<> Doc
var Doc -> Doc -> Doc
<> Doc
")"
        , Int -> [Doc] -> Doc
codeblock Int
2 [ Doc
"r = combine(x.accept(this, arg), r, arg);" ] ]
    | Bool
otherwise = Doc
"r = combine(" Doc -> Doc -> Doc
<> Doc
var Doc -> Doc -> Doc
<> Doc
".accept(this, arg), r, arg);"
      where
      var :: Doc
var = Doc
"p." Doc -> Doc -> Doc
<> Doc
nt
      varType :: String
varType = String -> [String] -> String -> String
typename String
packageAbsyn [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
cat
      et :: String
et      = String -> [String] -> String -> String
typename String
packageAbsyn [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
normCatOfList Cat
cat

--Just checks if something is a basic or user-defined type.
isBasicType :: [UserDef] -> String -> Bool
isBasicType :: [String] -> String -> Bool
isBasicType [String]
user String
v = String
v String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([String]
user [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Integer",String
"Character",String
"String",String
"Double"])