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

-}

module BNFC.Backend.Java.CFtoAbstractVisitor (cf2AbstractVisitor) where

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

cf2AbstractVisitor :: String -> String -> CF -> String
cf2AbstractVisitor :: String -> String -> CF -> String
cf2AbstractVisitor 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 Abstract Visitor */"
    , String
""
    , String
"public class AbstractVisitor<R,A> implements AllVisitor<R,A> {"
    , ((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) -> [(String, Reg)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Reg) -> String
forall a b. (a, b) -> a
fst ([(String, Reg)] -> [String]) -> [(String, Reg)] -> [String]
forall a b. (a -> b) -> a -> b
$ 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 b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ 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
  , [ String
"    public R visitDefault(" 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]
++ Cat -> String
identCat Cat
cat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" p, A arg) {"
    , String
"      throw new IllegalArgumentException(this.getClass()" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".getName() + \": \" + p);"
    , String
"    }"
    ]
  ]

--traverses a standard rule.
prRule :: String -> [UserDef] -> Cat -> Rule -> [String]
prRule :: String -> [String] -> Cat -> Rule -> [String]
prRule String
packageAbsyn [String]
_ Cat
_ (Rule RFun
fun RCat
_ SentForm
_ 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]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"    public R visit("
      , 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
      , String
" p, A arg) { return visitDefault(p, arg); }"
      ]
  | Bool
otherwise = []