{-
    BNF Converter: Datastructure for object-oriented abstract syntax generators
    Copyright (C) 2006  Author:  Aarne Ranta

    Description   : This module defines a data structure that is
                    used for generating abstract syntax in cpp_stl.
                    It should be used in other STL modules as well,
                    and could be used for object-oriented languages
                    in general, to avoid duplicated work.

    Author        : Aarne Ranta (aarne@cs.chalmers.se)
    Created       : 29 August, 2006

-}

module BNFC.Backend.Common.OOAbstract where

import BNFC.CF
import Data.List
import Data.Char(toLower)

-- A datastructure more appropriate than CF

data CAbs = CAbs {
  CAbs -> [String]
tokentypes :: [String],               -- user non-position token types
  CAbs -> [(String, Bool)]
listtypes  :: [(String,Bool)],        -- list types used, whether of classes
  CAbs -> [String]
absclasses :: [String],               -- grammar-def cats, normalized names
  CAbs -> [String]
conclasses :: [Fun],               -- constructors, except list ones
  CAbs -> [(String, [CAbsRule])]
signatures :: [(String,[CAbsRule])],  -- rules for each class, incl. pos tokens
  CAbs -> [String]
postokens  :: [String],               -- position token types
  CAbs -> [String]
defineds   :: [Fun]                -- defined (non-)constructors
  }

-- (valcat,(constr,args)), True = is class (not basic), class variable stored
type CAbsRule = (Fun,[(String,Bool,String)])

-- all those names that denote classes in C++
allClasses :: CAbs -> [String]
allClasses :: CAbs -> [String]
allClasses CAbs
ca =
  CAbs -> [String]
absclasses CAbs
ca [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CAbs -> [String]
conclasses CAbs
ca [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst (CAbs -> [(String, Bool)]
listtypes CAbs
ca) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CAbs -> [String]
postokens CAbs
ca

-- all those names that denote non-class types in C++
allNonClasses :: CAbs -> [String]
allNonClasses :: CAbs -> [String]
allNonClasses CAbs
ca =
  ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
basetypes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CAbs -> [String]
tokentypes CAbs
ca

cf2cabs :: CF -> CAbs
cf2cabs :: CF -> CAbs
cf2cabs CF
cf = CAbs :: [String]
-> [(String, Bool)]
-> [String]
-> [String]
-> [(String, [CAbsRule])]
-> [String]
-> [String]
-> CAbs
CAbs {
  tokentypes :: [String]
tokentypes = [String]
toks,
  listtypes :: [(String, Bool)]
listtypes  = [(String
c, (String, Bool) -> Bool
forall a b. (a, b) -> b
snd (String -> (String, Bool)
status (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
c))) | -- remove "List" from "ListC"
                  String
c <- (Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Cat -> String
identCat (Cat -> String) -> (Cat -> Cat) -> Cat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> Cat
normCat) [Cat]
lists],
  absclasses :: [String]
absclasses = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Cat -> String
forall a. Show a => a -> String
show(Cat -> String) -> (Cat -> Cat) -> Cat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Cat -> Cat
normCat) [Cat]
cats,
  conclasses :: [String]
conclasses = [String
f | Just String
f <- (Rul RFun -> Maybe String) -> [Rul RFun] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map Rul RFun -> Maybe String
forall a. IsFun a => Rul a -> Maybe String
testRule (CF -> [Rul RFun]
forall function. CFG function -> [Rul function]
cfgRules CF
cf)],
  signatures :: [(String, [CAbsRule])]
signatures = [(String, [CAbsRule])]
posdata [(String, [CAbsRule])]
-> [(String, [CAbsRule])] -> [(String, [CAbsRule])]
forall a. [a] -> [a] -> [a]
++ ((Cat, [(String, [Cat])]) -> (String, [CAbsRule]))
-> [(Cat, [(String, [Cat])])] -> [(String, [CAbsRule])]
forall a b. (a -> b) -> [a] -> [b]
map (Cat, [(String, [Cat])]) -> (String, [CAbsRule])
forall a.
(Cat, [(a, [Cat])]) -> (String, [(a, [(String, Bool, String)])])
normSig (CF -> [(Cat, [(String, [Cat])])]
cf2data CF
cf),
  postokens :: [String]
postokens  = [String]
pos,
  defineds :: [String]
defineds   = [String]
defs
  }
 where
  ([String]
pos,  [String]
toks) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (CF -> String -> Bool
forall f. CFG f -> String -> Bool
isPositionCat CF
cf) ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ ((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
  ([Cat]
lists,[Cat]
cats) = (Cat -> Bool) -> [Cat] -> ([Cat], [Cat])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Cat -> Bool
isList ([Cat] -> ([Cat], [Cat])) -> [Cat] -> ([Cat], [Cat])
forall a b. (a -> b) -> a -> b
$ CF -> [Cat]
allCatsNorm CF
cf
  testRule :: Rul a -> Maybe String
testRule (Rule a
f RCat
c SentForm
_ InternalRule
_)
   | Cat -> Bool
isList (RCat -> Cat
forall a. WithPosition a -> a
wpThing RCat
c)  = Maybe String
forall a. Maybe a
Nothing
   | a -> String
forall a. IsFun a => a -> String
funName a
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_"  = Maybe String
forall a. Maybe a
Nothing
   | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. IsFun a => a -> String
funName a
f
  normSig :: (Cat, [(a, [Cat])]) -> (String, [(a, [(String, Bool, String)])])
normSig (Cat
c,[(a, [Cat])]
fcs) =
    (Cat -> String
identCat Cat
c,[(a
f, [(String, Bool)] -> [(String, Bool, String)]
classVars ((Cat -> (String, Bool)) -> [Cat] -> [(String, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (String, Bool)
status (String -> (String, Bool))
-> (Cat -> String) -> Cat -> (String, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> String
identCat) [Cat]
cs)) | (a
f,[Cat]
cs) <- [(a, [Cat])]
fcs])
  posdata :: [(String, [CAbsRule])]
posdata =
    [(String
"Visitable",  -- to give superclass
     [(String
c,[(String
"String",Bool
False,String
"string_"),(String
"Integer",Bool
False,String
"integer_")])]) | String
c<-[String]
pos]
  status :: String -> (String, Bool)
status String
cat = (String
cat, String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
cat (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
basetypes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
toks))
  defs :: [String]
defs = [ RFun -> String
forall a. IsFun a => a -> String
funName RFun
f | FunDef RFun
f [String]
_ Exp
_ <- CF -> [Pragma]
forall function. CFG function -> [Pragma]
cfgPragmas CF
cf]

  classVars :: [(String,Bool)] -> [(String,Bool,String)]
  classVars :: [(String, Bool)] -> [(String, Bool, String)]
classVars [(String, Bool)]
cs =
    [(String
c,Bool
b,String
s) | ((String
c,Bool
b),String
s) <- [(String, Bool)] -> [String] -> [((String, Bool), String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Bool)]
cs ([String] -> [String] -> [String]
vars [] (((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
classVar (String -> String)
-> ((String, Bool) -> String) -> (String, Bool) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> String
forall a b. (a, b) -> a
fst) [(String, Bool)]
cs))]
  --- creating new names is quadratic, but parameter lists are short
  --- this should conform with Michael's naming
  vars :: [String] -> [String] -> [String]
vars [String]
seen [String]
vv = case [String]
vv of
    []   -> [String]
vv
    String
v:[String]
vs -> case [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
v) [String]
seen) of
      Int
0 | String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
v [String]
vs -> (String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"1")String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String] -> [String]
vars (String
vString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
seen) [String]
vs
      Int
0             -> String
v         String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String] -> [String]
vars (String
vString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
seen) [String]
vs
      Int
n             -> (String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String] -> [String]
vars (String
vString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
seen) [String]
vs

basetypes :: [(String, String)]
basetypes = [
  (String
"Integer",String
"int"),
  (String
"Char",   String
"char"),
  (String
"Double", String
"double"),
  (String
"String", String
"std::string"),
  (String
"Ident",  String
"std::string")
  ]

classVar :: String -> String
classVar :: String -> String
classVar String
c = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"

pointerIf :: Bool -> String -> String
pointerIf :: Bool -> String -> String
pointerIf Bool
b String
v = if Bool
b then String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v else String
v