{-# LANGUAGE LambdaCase #-}
module BNFC.Backend.Common.OOAbstract where
import Data.Char (toLower)
import qualified Data.List as List
import Data.Maybe
import BNFC.CF
data CAbs = CAbs {
CAbs -> [[Char]]
tokentypes :: [String],
CAbs -> [([Char], Bool)]
listtypes :: [(String,Bool)],
CAbs -> [[Char]]
absclasses :: [String],
CAbs -> [[Char]]
conclasses :: [Fun],
CAbs -> [([Char], [CAbsRule])]
signatures :: [(String,[CAbsRule])],
CAbs -> [[Char]]
postokens :: [String],
CAbs -> [[Char]]
defineds :: [Fun]
}
type CAbsRule = (Fun,[(String,Bool,String)])
allClasses :: CAbs -> [String]
allClasses :: CAbs -> [[Char]]
allClasses CAbs
ca =
CAbs -> [[Char]]
absclasses CAbs
ca forall a. [a] -> [a] -> [a]
++ CAbs -> [[Char]]
conclasses CAbs
ca forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (CAbs -> [([Char], Bool)]
listtypes CAbs
ca) forall a. [a] -> [a] -> [a]
++ CAbs -> [[Char]]
postokens CAbs
ca
allNonClasses :: CAbs -> [String]
allNonClasses :: CAbs -> [[Char]]
allNonClasses CAbs
ca =
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([Char], [Char])]
basetypes forall a. [a] -> [a] -> [a]
++ CAbs -> [[Char]]
tokentypes CAbs
ca
cf2cabs :: CF -> CAbs
cf2cabs :: CF -> CAbs
cf2cabs CF
cf = CAbs
{ tokentypes :: [[Char]]
tokentypes = [[Char]]
toks
, listtypes :: [([Char], Bool)]
listtypes = [([Char]
c, forall a b. (a, b) -> b
snd ([Char] -> ([Char], Bool)
status (forall a. Int -> [a] -> [a]
drop Int
4 [Char]
c))) |
[Char]
c <- forall a b. (a -> b) -> [a] -> [b]
map (Cat -> [Char]
identCat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> Cat
normCat) [Cat]
lists]
, absclasses :: [[Char]]
absclasses = forall a. Eq a => [a] -> [a]
List.nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Cat -> [Char]
identCat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> Cat
normCat) [Cat]
cats
, conclasses :: [[Char]]
conclasses = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. IsFun a => Rul a -> Maybe [Char]
testRule forall a b. (a -> b) -> a -> b
$ forall function. CFG function -> [Rul function]
cfgRules CF
cf
, signatures :: [([Char], [CAbsRule])]
signatures = [([Char], [CAbsRule])]
posdata forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall {a}.
(Cat, [(a, [Cat])]) -> ([Char], [(a, [([Char], Bool, [Char])])])
normSig (CF -> [Data]
cf2data CF
cf)
, postokens :: [[Char]]
postokens = [[Char]]
pos
, defineds :: [[Char]]
defineds = [[Char]]
defs
}
where
([[Char]]
pos, [[Char]]
toks) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (forall f. CFG f -> [Char] -> Bool
isPositionCat CF
cf) forall a b. (a -> b) -> a -> b
$ 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 -> [([Char], Reg)]
tokenPragmas CF
cf
([Cat]
lists,[Cat]
cats) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition Cat -> Bool
isList forall a b. (a -> b) -> a -> b
$ CF -> [Cat]
allCatsNorm CF
cf
testRule :: Rul a -> Maybe [Char]
testRule (Rule a
f RCat
c SentForm
_ InternalRule
_)
| Cat -> Bool
isList (forall a. WithPosition a -> a
wpThing RCat
c) = forall a. Maybe a
Nothing
| forall a. IsFun a => a -> [Char]
funName a
f forall a. Eq a => a -> a -> Bool
== [Char]
"_" = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsFun a => a -> [Char]
funName a
f
normSig :: (Cat, [(a, [Cat])]) -> ([Char], [(a, [([Char], Bool, [Char])])])
normSig (Cat
c,[(a, [Cat])]
fcs) =
(Cat -> [Char]
identCat Cat
c,[(a
f, [([Char], Bool)] -> [([Char], Bool, [Char])]
classVars (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> ([Char], Bool)
status forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> [Char]
identCat) [Cat]
cs)) | (a
f,[Cat]
cs) <- [(a, [Cat])]
fcs])
posdata :: [([Char], [CAbsRule])]
posdata =
[([Char]
"Visitable",
[([Char]
c,[([Char]
"String",Bool
False,[Char]
"string_"),([Char]
"Integer",Bool
False,[Char]
"integer_")])]) | [Char]
c<-[[Char]]
pos]
status :: [Char] -> ([Char], Bool)
status [Char]
cat = ([Char]
cat, forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Char]
cat (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([Char], [Char])]
basetypes forall a. [a] -> [a] -> [a]
++ [[Char]]
toks))
defs :: [[Char]]
defs = [ forall a. IsFun a => a -> [Char]
funName RFun
f | FunDef (Define RFun
f Telescope
_ Exp
_ Base
_) <- forall function. CFG function -> [Pragma]
cfgPragmas CF
cf]
classVars :: [(String,Bool)] -> [(String,Bool,String)]
classVars :: [([Char], Bool)] -> [([Char], Bool, [Char])]
classVars [([Char], Bool)]
cs =
[([Char]
c,Bool
b,[Char]
s) | (([Char]
c,Bool
b),[Char]
s) <- forall a b. [a] -> [b] -> [(a, b)]
zip [([Char], Bool)]
cs ([[Char]] -> [[Char]] -> [[Char]]
vars [] (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
classVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Char], Bool)]
cs))]
vars :: [[Char]] -> [[Char]] -> [[Char]]
vars [[Char]]
seen = \case
[] -> []
[Char]
v:[[Char]]
vs -> case forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
==[Char]
v) [[Char]]
seen) of
Int
0 | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
v [[Char]]
vs -> ([Char]
v forall a. [a] -> [a] -> [a]
++ [Char]
"1")forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]] -> [[Char]]
vars ([Char]
vforall a. a -> [a] -> [a]
:[[Char]]
seen) [[Char]]
vs
Int
0 -> [Char]
v forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]] -> [[Char]]
vars ([Char]
vforall a. a -> [a] -> [a]
:[[Char]]
seen) [[Char]]
vs
Int
n -> ([Char]
v forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
nforall a. Num a => a -> a -> a
+Int
1)) forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]] -> [[Char]]
vars ([Char]
vforall a. a -> [a] -> [a]
:[[Char]]
seen) [[Char]]
vs
basetypes :: [ (String, String) ]
basetypes :: [([Char], [Char])]
basetypes = [
([Char]
"Integer",[Char]
"int"),
([Char]
"Char", [Char]
"char"),
([Char]
"Double", [Char]
"double"),
([Char]
"String", [Char]
"std::string"),
([Char]
"Ident", [Char]
"std::string")
]
classVar :: String -> String
classVar :: [Char] -> [Char]
classVar [Char]
c = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
c forall a. [a] -> [a] -> [a]
++ [Char]
"_"
pointerIf :: Bool -> String -> String
pointerIf :: Bool -> [Char] -> [Char]
pointerIf Bool
b [Char]
v = if Bool
b then [Char]
"*" forall a. [a] -> [a] -> [a]
++ [Char]
v else [Char]
v