{-# LANGUAGE LambdaCase #-}

{-
    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 Data.Char  (toLower)
import qualified Data.List as List
import Data.Maybe

import BNFC.CF

-- A datastructure more appropriate than CF

data CAbs = CAbs {
  CAbs -> [[Char]]
tokentypes :: [String],               -- user non-position token types
  CAbs -> [([Char], Bool)]
listtypes  :: [(String,Bool)],        -- list types used, whether of classes
  CAbs -> [[Char]]
absclasses :: [String],               -- grammar-def cats, normalized names
  CAbs -> [[Char]]
conclasses :: [Fun],               -- constructors, except list ones
  CAbs -> [([Char], [CAbsRule])]
signatures :: [(String,[CAbsRule])],  -- rules for each class, incl. pos tokens
  CAbs -> [[Char]]
postokens  :: [String],               -- position token types
  CAbs -> [[Char]]
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 -> [[Char]]
allClasses CAbs
ca =
  CAbs -> [[Char]]
absclasses CAbs
ca [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ CAbs -> [[Char]]
conclasses CAbs
ca [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (([Char], Bool) -> [Char]) -> [([Char], Bool)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Bool) -> [Char]
forall a b. (a, b) -> a
fst (CAbs -> [([Char], Bool)]
listtypes CAbs
ca) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ CAbs -> [[Char]]
postokens CAbs
ca

-- all those names that denote non-class types in C++
allNonClasses :: CAbs -> [String]
allNonClasses :: CAbs -> [[Char]]
allNonClasses CAbs
ca =
  (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst [([Char], [Char])]
basetypes [[Char]] -> [[Char]] -> [[Char]]
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, ([Char], Bool) -> Bool
forall a b. (a, b) -> b
snd ([Char] -> ([Char], Bool)
status (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
4 [Char]
c))) | -- remove "List" from "ListC"
                  [Char]
c <- (Cat -> [Char]) -> [Cat] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Cat -> [Char]
identCat (Cat -> [Char]) -> (Cat -> Cat) -> Cat -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> Cat
normCat) [Cat]
lists]
  , absclasses :: [[Char]]
absclasses = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
List.nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Cat -> [Char]) -> [Cat] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Cat -> [Char]
identCat (Cat -> [Char]) -> (Cat -> Cat) -> Cat -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> Cat
normCat) [Cat]
cats -- NB: does not include list categories
  , conclasses :: [[Char]]
conclasses = (Rul RFun -> Maybe [Char]) -> [Rul RFun] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Rul RFun -> Maybe [Char]
forall {a}. IsFun a => Rul a -> Maybe [Char]
testRule ([Rul RFun] -> [[Char]]) -> [Rul RFun] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CF -> [Rul RFun]
forall function. CFG function -> [Rul function]
cfgRules CF
cf
  , signatures :: [([Char], [CAbsRule])]
signatures = [([Char], [CAbsRule])]
posdata [([Char], [CAbsRule])]
-> [([Char], [CAbsRule])] -> [([Char], [CAbsRule])]
forall a. [a] -> [a] -> [a]
++ ((Cat, [([Char], [Cat])]) -> ([Char], [CAbsRule]))
-> [(Cat, [([Char], [Cat])])] -> [([Char], [CAbsRule])]
forall a b. (a -> b) -> [a] -> [b]
map (Cat, [([Char], [Cat])]) -> ([Char], [CAbsRule])
forall {a}.
(Cat, [(a, [Cat])]) -> ([Char], [(a, [([Char], Bool, [Char])])])
normSig (CF -> [(Cat, [([Char], [Cat])])]
cf2data CF
cf)
  , postokens :: [[Char]]
postokens  = [[Char]]
pos
  , defineds :: [[Char]]
defineds   = [[Char]]
defs
  }
 where
  ([[Char]]
pos,  [[Char]]
toks) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (CF -> [Char] -> Bool
forall f. CFG f -> [Char] -> Bool
isPositionCat CF
cf) ([[Char]] -> ([[Char]], [[Char]]))
-> [[Char]] -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ (([Char], Reg) -> [Char]) -> [([Char], Reg)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Reg) -> [Char]
forall a b. (a, b) -> a
fst ([([Char], Reg)] -> [[Char]]) -> [([Char], Reg)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CF -> [([Char], Reg)]
forall f. CFG f -> [([Char], Reg)]
tokenPragmas CF
cf
  ([Cat]
lists,[Cat]
cats) = (Cat -> Bool) -> [Cat] -> ([Cat], [Cat])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.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 [Char]
testRule (Rule a
f RCat
c SentForm
_ InternalRule
_)
   | Cat -> Bool
isList (RCat -> Cat
forall a. WithPosition a -> a
wpThing RCat
c)  = Maybe [Char]
forall a. Maybe a
Nothing
   | a -> [Char]
forall a. IsFun a => a -> [Char]
funName a
f [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"_"  = Maybe [Char]
forall a. Maybe a
Nothing
   | Bool
otherwise = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ a -> [Char]
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 ((Cat -> ([Char], Bool)) -> [Cat] -> [([Char], Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> ([Char], Bool)
status ([Char] -> ([Char], Bool))
-> (Cat -> [Char]) -> Cat -> ([Char], Bool)
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",  -- to give superclass
     [([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, [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Char]
cat ((([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst [([Char], [Char])]
basetypes [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
toks))
  defs :: [[Char]]
defs = [ RFun -> [Char]
forall a. IsFun a => a -> [Char]
funName RFun
f | FunDef (Define RFun
f Telescope
_ Exp
_ Base
_) <- CF -> [Pragma]
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) <- [([Char], Bool)] -> [[Char]] -> [(([Char], Bool), [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [([Char], Bool)]
cs ([[Char]] -> [[Char]] -> [[Char]]
vars [] ((([Char], Bool) -> [Char]) -> [([Char], Bool)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
classVar ([Char] -> [Char])
-> (([Char], Bool) -> [Char]) -> ([Char], Bool) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Bool) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], Bool)]
cs))]
  --- creating new names is quadratic, but parameter lists are short
  --- this should conform with Michael's naming
  vars :: [[Char]] -> [[Char]] -> [[Char]]
vars [[Char]]
seen = \case
    []   -> []
    [Char]
v:[[Char]]
vs -> case [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
v) [[Char]]
seen) of
      Int
0 | [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
v [[Char]]
vs -> ([Char]
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"1")[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]] -> [[Char]]
vars ([Char]
v[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
seen) [[Char]]
vs
      Int
0             -> [Char]
v         [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]] -> [[Char]]
vars ([Char]
v[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
seen) [[Char]]
vs
      Int
n             -> ([Char]
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]] -> [[Char]]
vars ([Char]
v[Char] -> [[Char]] -> [[Char]]
forall 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 = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"

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