{-# LANGUAGE OverloadedStrings #-}
module BNFC.Backend.Java.CFtoComposVisitor (cf2ComposVisitor) where
import Prelude hiding ((<>))
import Data.List (intercalate)
import Data.Either (lefts)
import BNFC.CF
import BNFC.Backend.Java.CFtoJavaAbs15 (typename)
import BNFC.Utils ((+++))
import BNFC.Backend.Common.NamedVariables
import BNFC.PrettyPrint
cf2ComposVisitor :: String -> String -> CF -> String
cf2ComposVisitor :: String -> String -> CF -> String
cf2ComposVisitor String
packageBase String
packageAbsyn CF
cf = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
header
, forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> (Cat, [Rule]) -> String
prData String
packageAbsyn [String]
user) [(Cat, [Rule])]
groups
, String
"}"
]
where
user :: [String]
user = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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)
]
is :: [String]
is = forall a b. (a -> b) -> [a] -> [b]
map (String -> (Cat, [Rule]) -> String
prInterface String
packageAbsyn) [(Cat, [Rule])]
groups
header :: String
header = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ String
"package" String -> String -> String
+++ String
packageBase forall a. [a] -> [a] -> [a]
++ String
";"
, String
"/** Composition Visitor"
, String
"*/"
, String
""
, String
"public class ComposVisitor<A>" forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
is then String
"" else String
" implements"
]
, [ forall a. [a] -> [[a]] -> [a]
intercalate String
",\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String
" " forall a. [a] -> [a] -> [a]
++) [String]
is | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
is ]
, [ String
"{" ]
]
prInterface :: String -> (Cat, [Rule]) -> String
prInterface :: String -> (Cat, [Rule]) -> String
prInterface String
packageAbsyn (Cat
cat, [Rule]
_) =
String
q forall a. [a] -> [a] -> [a]
++ String
".Visitor<" forall a. [a] -> [a] -> [a]
++ String
q forall a. [a] -> [a] -> [a]
++ String
",A>"
where q :: String
q = String
packageAbsyn forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
cat
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
" /* " forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
cat forall a. [a] -> [a] -> [a]
++ String
" */"
, Doc -> String
render forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall f. IsFun f => String -> [String] -> Cat -> Rul f -> Doc
prRule String
packageAbsyn [String]
user Cat
cat) [Rule]
rules
]
prRule :: IsFun f => String -> [UserDef] -> Cat -> Rul f -> Doc
prRule :: forall f. IsFun f => String -> [String] -> Cat -> Rul f -> Doc
prRule String
packageAbsyn [String]
user Cat
cat (Rule f
fun RCat
_ SentForm
cats InternalRule
_)
| Bool -> Bool
not (forall a. IsFun a => a -> Bool
isCoercion f
fun Bool -> Bool -> Bool
|| forall a. IsFun a => a -> Bool
isDefinedRule f
fun) = Int -> Doc -> Doc
nest Int
4 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
[ Doc
"public " Doc -> Doc -> Doc
<> String -> Doc
qual (Cat -> String
identCat Cat
cat) Doc -> Doc -> Doc
<> Doc
" visit(" Doc -> Doc -> Doc
<> Doc
cls Doc -> Doc -> Doc
<> Doc
" p, A arg)"
, Int -> [Doc] -> Doc
codeblock Int
2
[ [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> (Cat, Doc) -> Doc
prCat String
packageAbsyn [String]
user) [(Cat, Doc)]
cats')
, Doc
"return new" Doc -> Doc -> Doc
<+> Doc
cls Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
"," [Doc]
vnames)) Doc -> Doc -> Doc
<> Doc
";"
]
]
where
cats' :: [(Cat, Doc)]
cats' = forall a b. [Either a b] -> [a]
lefts forall a b. (a -> b) -> a -> b
$ forall a. [Either Cat a] -> [Either (Cat, Doc) a]
numVars SentForm
cats
cls :: Doc
cls = String -> Doc
qual forall a b. (a -> b) -> a -> b
$ forall a. IsFun a => a -> String
funName f
fun
qual :: String -> Doc
qual String
s = String -> Doc
text (String
packageAbsyn forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
s)
vnames :: [Doc]
vnames = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Cat, Doc)]
cats'
prRule String
_ [String]
_ Cat
_ Rul f
_ = Doc
empty
prCat :: String
-> [UserDef]
-> (Cat, Doc)
-> Doc
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 -> Doc
decl Doc
var
| Cat -> Bool
isList Cat
cat = [Doc] -> Doc
vcat
[ Doc -> Doc
decl (Doc
"new" Doc -> Doc -> Doc
<+> String -> Doc
text String
varType Doc -> Doc -> Doc
<> Doc
"()")
, 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
nt Doc -> Doc -> Doc
<> Doc
".add(x.accept(this,arg));" ]
]
| Bool
otherwise = Doc -> Doc
decl (Doc
var Doc -> Doc -> Doc
<> Doc
".accept(this, arg)")
where
var :: Doc
var = Doc
"p." Doc -> Doc -> Doc
<> Doc
nt
varType :: String
varType = String -> [String] -> String -> String
typename String
packageAbsyn [String]
user forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCat Cat
cat
et :: String
et = String -> [String] -> String -> String
typename String
packageAbsyn [String]
user forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCatOfList Cat
cat
decl :: Doc -> Doc
decl Doc
v = String -> Doc
text String
varType Doc -> Doc -> Doc
<+> Doc
nt Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Doc
v Doc -> Doc -> Doc
<> Doc
";"
isBasicType :: [UserDef] -> String -> Bool
isBasicType :: [String] -> String -> Bool
isBasicType [String]
user String
v =
String
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([String]
user forall a. [a] -> [a] -> [a]
++ [String
"Integer",String
"Character",String
"String",String
"Double"])