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

-}

module BNFC.Backend.Java.CFtoAllVisitor (cf2AllVisitor) where

import Data.List
import BNFC.CF
import BNFC.Utils ((+++))
import BNFC.Backend.Common.NamedVariables


cf2AllVisitor :: String -> String -> CF -> String
cf2AllVisitor :: String -> String -> CF -> String
cf2AllVisitor String
packageBase String
packageAbsyn CF
cf = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ String
"package" String -> String -> String
+++ String
packageBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    , String
""
    , String
"/** BNFC-Generated All Visitor */"
    , String
""
    , String
"public interface AllVisitor<R,A>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
is then String
"" else String
" extends"
    ]
  , [ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
",\n" ([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]
is | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
is ]
  , [ String
"{}" ]
  ]
  where
    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) ]
    is :: [String]
is     = ((Cat, [Rule]) -> String) -> [(Cat, [Rule])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (Cat, [Rule]) -> String
prInterface String
packageAbsyn) [(Cat, [Rule])]
groups

prInterface :: String -> (Cat, [Rule]) -> String
prInterface :: String -> (Cat, [Rule]) -> String
prInterface String
packageAbsyn (Cat
cat, [Rule]
_) =
    String
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".Visitor<R,A>"
  where q :: String
q = String
packageAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
cat