{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

{-
    BNF Converter: C++ abstract syntax generator
    Copyright (C) 2004  Author:  Michael Pellauer

    Description   : This module generates the C++ Abstract Syntax
                    tree classes. It generates both a Header file
                    and an Implementation file, and uses the Visitor
                    design pattern.

    Author        : Michael Pellauer
    Created       : 4 August, 2003
    Modified      : 22 May, 2004 / Antti-Juhani Kaijanaho
-}

module BNFC.Backend.CPP.NoSTL.CFtoCPPAbs (cf2CPPAbs) where

import Prelude hiding ((<>))

import Data.List  ( findIndices, intersperse )
import Data.Char  ( toLower )
import Text.PrettyPrint

import BNFC.CF
import BNFC.TypeChecker ( ListConstructors(..) )
import BNFC.Utils       ( (+++), (++++) )

import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.Common.OOAbstract
import BNFC.Backend.CPP.Common


--The result is two files (.H file, .C file)
cf2CPPAbs :: String -> CF -> (String, String)
cf2CPPAbs :: String -> CF -> (String, String)
cf2CPPAbs String
_ CF
cf = (CF -> String
mkHFile CF
cf, CF -> String
mkCFile CF
cf)


{- **** Header (.H) File Functions **** -}

--Makes the Header file.
mkHFile :: CF -> String
mkHFile :: CF -> String
mkHFile CF
cf = [String] -> String
unlines
 [
  String
"#ifndef ABSYN_HEADER",
  String
"#define ABSYN_HEADER",
  String
"",
  String
header,
  [String] -> String
forall {t :: * -> *}. Foldable t => t String -> String
prTypeDefs [String]
user,
  String
"/********************   Forward Declarations    ********************/\n",
  (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
prForward [String]
classes,
  String
"",
  [String] -> String
prVisitor [String]
classes,
  String
prVisitable,
  String
"",
  String
"/********************   Abstract Syntax Classes    ********************/\n",
  (Data -> String) -> [Data] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Data -> String
prDataH [String]
user) (CF -> [Data]
getAbstractSyntax CF
cf),
  String
"",
  Maybe ListConstructors -> CF -> String -> String
definedRules Maybe ListConstructors
forall a. Maybe a
Nothing CF
cf
  String
"/********************   Defined Constructors    ********************/",
  String
"",
  String
"#endif"
 ]
 where
  user :: [String]
user = ([String], [Reg]) -> [String]
forall a b. (a, b) -> a
fst ([(String, Reg)] -> ([String], [Reg])
forall a b. [(a, b)] -> ([a], [b])
unzip (CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf)) -- includes position tokens
  -- user = [ name | TokenReg name False _ <- cfgPragmas cf ]  -- position tokens are in allClasses already
  header :: String
header = String
"/* ~~~ C++ Abstract Syntax Interface generated by the BNF Converter.\n ~~~ */"
  ca :: CAbs
ca = CF -> CAbs
cf2cabs CF
cf
  classes :: [String]
classes = 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)
  -- classes = allClasses (cf2cabs cf)  -- includes position tokens
  prForward :: String -> String
prForward String
s | String -> Bool
forall a. IsFun a => a -> Bool
isProperLabel String
s = String
"class " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
  prForward String
_ = String
""

--Prints interface classes for all categories.
prDataH :: [UserDef] -> Data -> String
prDataH :: [String] -> Data -> String
prDataH  [String]
user (Cat
cat, [(String, [Cat])]
rules) =
    case String -> [(String, [Cat])] -> Maybe [Cat]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Cat -> String
catToStr Cat
cat) [(String, [Cat])]
rules of
        Just [Cat]
_ -> ((String, [Cat]) -> String) -> [(String, [Cat])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Cat -> (String, [Cat]) -> String
prRuleH [String]
user Cat
cat) [(String, [Cat])]
rules
        Maybe [Cat]
Nothing -> if Cat -> Bool
isList Cat
cat
            then ((String, [Cat]) -> String) -> [(String, [Cat])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Cat -> (String, [Cat]) -> String
prRuleH [String]
user Cat
cat) [(String, [Cat])]
rules
            else [String] -> String
unlines
                [ String
"class" String -> String -> String
+++ Cat -> String
identCat Cat
cat String -> String -> String
+++ String
": public Visitable {"
                , String
"public:"
                , String
"  virtual" String -> String -> String
+++ Cat -> String
identCat Cat
cat String -> String -> String
+++ String
"*clone() const = 0;"
                , String
"};\n"
                , ((String, [Cat]) -> String) -> [(String, [Cat])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Cat -> (String, [Cat]) -> String
prRuleH [String]
user Cat
cat) [(String, [Cat])]
rules
                ]

--Interface definitions for rules vary on the type of rule.
prRuleH :: [UserDef] -> Cat -> (Fun, [Cat]) -> String
prRuleH :: [String] -> Cat -> (String, [Cat]) -> String
prRuleH [String]
user Cat
c (String
fun, [Cat]
cats) =
    if String -> Bool
forall a. IsFun a => a -> Bool
isNilFun String
fun Bool -> Bool -> Bool
|| String -> Bool
forall a. IsFun a => a -> Bool
isOneFun String
fun
    then String
""  --these are not represented in the AbSyn
    else if String -> Bool
forall a. IsFun a => a -> Bool
isConsFun String
fun
    then --this is the linked list case.
    [String] -> String
unlines
    [
     String
"class" String -> String -> String
+++ String
c' String -> String -> String
+++ String
": public Visitable",
     String
"{",
     String
" public:",
     Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [String] -> [IVar] -> Doc
prInstVars [String]
user [IVar]
vs,
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const" String -> String -> String
+++ String
c' String -> String -> String
+++ String
"&);",
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" &operator=(const" String -> String -> String
+++ String
c' String -> String -> String
+++ String
"&);",
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> [IVar] -> String
forall b. Int -> [(String, b)] -> String
prConstructorH Int
1 [IVar]
vs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");",
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mem String -> String -> String
+++ String
memstar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"p);",
     String -> String
prDestructorH String
c',
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"* reverse();",
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"* reverse(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *l);",
     String
"  virtual void accept(Visitor *v);",
     String
"  virtual " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *clone() const;",
     String
"  void swap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
+++ String
"&);",
     String
"};"
    ]
    else --a standard rule
    [String] -> String
unlines
    [
     String
"class" String -> String -> String
+++ String
fun String -> String -> String
+++ String
": public" String -> String -> String
+++ String
super,
     String
"{",
     String
" public:",
     Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [String] -> [IVar] -> Doc
prInstVars [String]
user [IVar]
vs,
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const" String -> String -> String
+++ String
fun String -> String -> String
+++ String
"&);",
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" &operator=(const" String -> String -> String
+++ String
fun String -> String -> String
+++ String
"&);",
     String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [IVar] -> String
forall b. Int -> [(String, b)] -> String
prConstructorH Int
1 [IVar]
vs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");",
     String -> String
prDestructorH String
fun,
     String
"  virtual void accept(Visitor *v);",
     String
"  virtual " String -> String -> String
+++ String
fun String -> String -> String
+++ String
" *clone() const;",
     String
"  void swap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
+++ String
"&);",
     String
"};\n"
    ]
   where
     vs :: [IVar]
vs = [Cat] -> [IVar]
getVars [Cat]
cats
     c' :: String
c' = Cat -> String
identCat (Cat -> Cat
normCat Cat
c);
     mem :: String
mem = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
c'
     memstar :: String
memstar = if [String] -> String -> Bool
isBasic [String]
user String
mem then String
"" else String
"*"
     super :: String
super = if Cat -> String
catToStr Cat
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fun then String
"Visitable" else Cat -> String
identCat Cat
c
     prConstructorH :: Int -> [(String, b)] -> String
     prConstructorH :: forall b. Int -> [(String, b)] -> String
prConstructorH Int
_ [] = String
""
     prConstructorH Int
n [(String
t,b
_)] = String
t String -> String -> String
+++ String -> String
forall {p}. IsString p => String -> p
optstar String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
     prConstructorH Int
n ((String
t,b
_):[(String, b)]
vs) = String
t String -> String -> String
+++ String -> String
forall {p}. IsString p => String -> p
optstar String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [(String, b)] -> String
forall b. Int -> [(String, b)] -> String
prConstructorH (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(String, b)]
vs
     prDestructorH :: String -> String
prDestructorH String
n = String
"  ~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"();"
     optstar :: String -> p
optstar String
x = if [String] -> String -> Bool
isBasic [String]
user String
x
       then p
""
       else p
"*"

prVisitable :: String
prVisitable :: String
prVisitable = [String] -> String
unlines
 [
  String
"class Visitable",
  String
"{",
  String
" public:",
  -- all classes with virtual methods require a virtual destructor
  String
"  virtual ~Visitable() {}",
  String
"  virtual void accept(Visitor *v) = 0;",
  String
"};\n"
 ]

prVisitor :: [String] -> String
prVisitor :: [String] -> String
prVisitor [String]
fs = [String] -> String
unlines
 [
  String
"/********************   Visitor Interfaces    ********************/",
  String
"",
  String
"class Visitor",
  String
"{",
  String
" public:",
  String
"  virtual ~Visitor() {}",
  (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
prVisitFun [String]
fs,
  String
footer
 ]
 where
   footer :: String
footer = [String] -> String
unlines
    [  --later only include used categories
     String
"  virtual void visitInteger(Integer i) = 0;",
     String
"  virtual void visitDouble(Double d) = 0;",
     String
"  virtual void visitChar(Char c) = 0;",
     String
"  virtual void visitString(String s) = 0;",
     String
"};"
    ]
   prVisitFun :: String -> String
prVisitFun String
f | String -> Bool
forall a. IsFun a => a -> Bool
isProperLabel String
f =
     String
"  virtual void visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *p) = 0;\n"
   prVisitFun String
_ = String
""

--typedefs in the Header make generation much nicer.
prTypeDefs :: t String -> String
prTypeDefs t String
user = [String] -> String
unlines
  [
   String
"/********************   TypeDef Section    ********************/",
   String
"typedef int Integer;",
   String
"typedef char Char;",
   String
"typedef double Double;",
   String
"typedef char* String;",
   String
"typedef char* Ident;",
   (String -> String) -> t String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
prUserDef t String
user
  ]
 where
  prUserDef :: String -> String
prUserDef String
s = String
"typedef char* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"

-- | A class's instance variables.
-- >>> prInstVars ["MyTokn"] [("MyTokn",1), ("A",1), ("A",2)]
-- MyTokn mytokn_1;
-- A *a_1, *a_2;
prInstVars :: [UserDef] -> [IVar] -> Doc
prInstVars :: [String] -> [IVar] -> Doc
prInstVars [String]
_ [] = Doc
empty
prInstVars [String]
user vars :: [IVar]
vars@((String
t,Int
_):[IVar]
_) =
    String -> Doc
text String
t Doc -> Doc -> Doc
<+> Doc
uniques Doc -> Doc -> Doc
<> Doc
";" Doc -> Doc -> Doc
$$ [String] -> [IVar] -> Doc
prInstVars [String]
user [IVar]
vs'
 where
    (Doc
uniques, [IVar]
vs') = String -> (Doc, [IVar])
prUniques String
t
    --these functions group the types together nicely
    prUniques :: String -> (Doc, [IVar])
    prUniques :: String -> (Doc, [IVar])
prUniques String
t = ([Int] -> Doc
prVars ((IVar -> Bool) -> [IVar] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (\(String
y,Int
_) ->  String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t) [IVar]
vars), String -> [IVar] -> [IVar]
remType String
t [IVar]
vars)
    prVars :: [Int] -> Doc
prVars = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Int] -> [Doc]) -> [Int] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Int] -> [Doc]) -> [Int] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc
prVar
    prVar :: Int -> Doc
prVar Int
x = let (String
t,Int
n) = [IVar]
vars [IVar] -> Int -> IVar
forall a. [a] -> Int -> a
!! Int
x in String -> Doc
varLinkName String
t Doc -> Doc -> Doc
<> String -> Doc
text (Int -> String
forall {a}. (Eq a, Num a, Show a) => a -> String
showNum Int
n)
    varLinkName :: String -> Doc
varLinkName String
z = if [String] -> String -> Bool
isBasic [String]
user String
z
      then String -> Doc
text ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
z) Doc -> Doc -> Doc
<> Doc
"_"
      else Doc
"*" Doc -> Doc -> Doc
<> String -> Doc
text ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
z) Doc -> Doc -> Doc
<> Doc
"_"
    remType :: String -> [IVar] -> [IVar]
    remType :: String -> [IVar] -> [IVar]
remType String
_ [] = []
    remType String
t ((String
t2,Int
n):[IVar]
ts) = if String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t2
        then String -> [IVar] -> [IVar]
remType String
t [IVar]
ts
        else (String
t2,Int
n) IVar -> [IVar] -> [IVar]
forall a. a -> [a] -> [a]
: String -> [IVar] -> [IVar]
remType String
t [IVar]
ts


{- **** Implementation (.C) File Functions **** -}

--Makes the .C file
mkCFile :: CF -> String
mkCFile :: CF -> String
mkCFile CF
cf = [String] -> String
unlines
 [
  String
header,
  (Data -> String) -> [Data] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Data -> String
prDataC [String]
user) (CF -> [Data]
getAbstractSyntax CF
cf),
  Maybe ListConstructors -> CF -> String -> String
definedRules (ListConstructors -> Maybe ListConstructors
forall a. a -> Maybe a
Just (ListConstructors -> Maybe ListConstructors)
-> ListConstructors -> Maybe ListConstructors
forall a b. (a -> b) -> a -> b
$ (Base -> (String, Type))
-> (Base -> (String, Type)) -> ListConstructors
LC Base -> (String, Type)
forall {t} {p}. IsString t => p -> (t, Type)
nil Base -> (String, Type)
cons) CF
cf
  String
"/********************   Defined Constructors    ********************/"
 ]
 where
  nil :: p -> (t, Type)
nil p
_  = (,Type
dummyType) (t -> (t, Type)) -> t -> (t, Type)
forall a b. (a -> b) -> a -> b
$ t
"NULL"
  cons :: Base -> (String, Type)
cons Base
t = (,Type
dummyType) (String -> (String, Type)) -> String -> (String, Type)
forall a b. (a -> b) -> a -> b
$ String
"new List" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Base -> String
identType Base
t
  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 (CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf)
  header :: String
header = [String] -> String
unlines
   [
    String
"//C++ Abstract Syntax Implementation generated by the BNF Converter.",
    String
"#include <algorithm>",
    String
"#include \"Absyn.H\""
   ]

--This is not represented in the implementation.
prDataC :: [UserDef] -> Data -> String
prDataC :: [String] -> Data -> String
prDataC [String]
user (Cat
cat, [(String, [Cat])]
rules) = ((String, [Cat]) -> String) -> [(String, [Cat])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> Cat -> (String, [Cat]) -> String
prRuleC [String]
user Cat
cat) [(String, [Cat])]
rules

--Classes for rules vary based on the type of rule.
prRuleC :: [String] -> Cat -> (String, [Cat]) -> String
prRuleC [String]
user Cat
c (String
fun, [Cat]
cats) =
    if String -> Bool
forall a. IsFun a => a -> Bool
isNilFun String
fun Bool -> Bool -> Bool
|| String -> Bool
forall a. IsFun a => a -> Bool
isOneFun String
fun
    then String
""  --these are not represented in the AbSyn
    else if String -> Bool
forall a. IsFun a => a -> Bool
isConsFun String
fun
    then --this is the linked list case.
    [String] -> String
unlines
    [
     String
"/********************   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    ********************/",
     Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String -> [IVar] -> [Cat] -> Doc
prConstructorC [String]
user String
c' [IVar]
vs [Cat]
cats,
     [String] -> String -> [IVar] -> String
prCopyC [String]
user String
c' [IVar]
vs,
     [String] -> String -> [IVar] -> String
prDestructorC [String]
user String
c' [IVar]
vs,
     [String] -> String -> String
prListFuncs [String]
user String
c',
     String -> String
prAcceptC String
c',
     [String] -> String -> [IVar] -> String
prCloneC [String]
user String
c' [IVar]
vs,
     String
""
    ]
    else --a standard rule
    [String] -> String
unlines
    [
     String
"/********************   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    ********************/",
     Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String -> [IVar] -> [Cat] -> Doc
prConstructorC [String]
user String
fun [IVar]
vs [Cat]
cats,
     [String] -> String -> [IVar] -> String
prCopyC [String]
user String
fun [IVar]
vs,
     [String] -> String -> [IVar] -> String
prDestructorC [String]
user String
fun [IVar]
vs,
     String -> String
prAcceptC String
fun,
     [String] -> String -> [IVar] -> String
prCloneC [String]
user String
fun [IVar]
vs,
     String
""
    ]
   where
     vs :: [IVar]
vs = [Cat] -> [IVar]
getVars [Cat]
cats
     c' :: String
c' = Cat -> String
identCat (Cat -> Cat
normCat Cat
c)

--These are all built-in list functions.
--Later we could include things like lookup,insert,delete,etc.
prListFuncs :: [UserDef] -> String -> String
prListFuncs :: [String] -> String -> String
prListFuncs [String]
user String
c = [String] -> String
unlines
 [
  String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m String -> String -> String
+++ String
mstar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"p)",
  String
"{",
  String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = p;",
  String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"= 0;",
  String
"}",
  String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
+++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverse()",
  String
"{",
  String
"  if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
+++ String
"== 0) return this;",
  String
"  else",
  String
"  {",
  String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *tmp =" String -> String -> String
+++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->reverse(this);",
  String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
+++ String
"= 0;",
  String
"    return tmp;",
  String
"  }",
  String
"}",
  String
"",
  String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
+++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"reverse(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"* prev)",
  String
"{",
  String
"  if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
+++ String
"== 0)",
  String
"  {",
  String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
+++ String
"= prev;",
  String
"    return this;",
  String
"  }",
  String
"  else",
  String
"  {",
  String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
+++ String
"*tmp =" String -> String -> String
+++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->reverse(this);",
  String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
+++ String
"= prev;",
  String
"    return tmp;",
  String
"  }",
  String
"}"
 ]
 where
   v :: String
v = (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
"_"
   m :: String
m = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
c
   mstar :: String
mstar = if [String] -> String -> Bool
isBasic [String]
user String
m then String
"" else String
"*"
   m' :: String
m' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
v

--The standard accept function for the Visitor pattern
prAcceptC :: String -> String
prAcceptC :: String -> String
prAcceptC String
ty =
  String
"\nvoid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::accept(Visitor *v) { v->visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(this); }"

-- | The constructor just assigns the parameters to the corresponding instance
-- variables.
-- >>> prConstructorC ["Integer"] "bla" [("A",1), ("Integer",1), ("A",2)] [Cat "A", Cat "Integer", Cat "A"]
-- bla::bla(A *p1, Integer p2, A *p3) { a_1 = p1; integer_ = p2; a_2 = p3; }
prConstructorC :: [UserDef] -> String -> [IVar] -> [Cat] -> Doc
prConstructorC :: [String] -> String -> [IVar] -> [Cat] -> Doc
prConstructorC [String]
user String
c [IVar]
vs [Cat]
cats =
    String -> Doc
text String
c Doc -> Doc -> Doc
<> Doc
"::" Doc -> Doc -> Doc
<> String -> Doc
text String
c Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
args
    Doc -> Doc -> Doc
<+> Doc
"{" Doc -> Doc -> Doc
<+> String -> Doc
text ([IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
params) Doc -> Doc -> Doc
<> Doc
"}"
  where
    ([String]
types, [String]
params) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([Cat] -> Int -> Int -> [(String, String)]
prParams [Cat]
cats ([Cat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cat]
cats) ([Cat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cat]
catsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
    args :: Doc
args = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
"," ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (String -> String -> Doc) -> [String] -> [String] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> Doc
prArg [String]
types [String]
params
    prArg :: String -> String -> Doc
prArg String
type_ String
name
      | [String] -> String -> Bool
isBasic [String]
user String
type_  = String -> Doc
text String
type_ Doc -> Doc -> Doc
<+> String -> Doc
text String
name
      | Bool
otherwise           = String -> Doc
text String
type_ Doc -> Doc -> Doc
<+> Doc
"*" Doc -> Doc -> Doc
<> String -> Doc
text String
name

--Print copy constructor and copy assignment
prCopyC :: [UserDef] -> String -> [IVar] -> String
prCopyC :: [String] -> String -> [IVar] -> String
prCopyC [String]
user String
c [IVar]
vs =
    String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const" String -> String -> String
+++ String
c String -> String -> String
+++ String
"& other) {" String -> String -> String
+++
      (IVar -> String) -> [IVar] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IVar -> String
doV [IVar]
vs String -> String -> String
++++
      String
"}" String -> String -> String
++++
      String
c String -> String -> String
+++ String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"operator=(const" String -> String -> String
+++ String
c String -> String -> String
+++ String
"& other) {" String -> String -> String
++++
      String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
+++ String
"tmp(other);" String -> String -> String
++++
      String
"  swap(tmp);" String -> String -> String
++++
      String
"  return *this;" String -> String -> String
++++
      String
"}" String -> String -> String
++++
      String
"void" String -> String -> String
+++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::swap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
+++ String
"& other) {" String -> String -> String
++++
      (IVar -> String) -> [IVar] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IVar -> String
swapV [IVar]
vs String -> String -> String
++++
      String
"}\n"
    where  doV :: IVar -> String
           doV :: IVar -> String
doV v :: IVar
v@(String
t, Int
_)
             | [String] -> String -> Bool
isBasic [String]
user String
t = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IVar -> String
vn IVar
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = other." String -> String -> String
forall a. [a] -> [a] -> [a]
++ IVar -> String
vn IVar
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
             | Bool
otherwise = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IVar -> String
vn IVar
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = other." String -> String -> String
forall a. [a] -> [a] -> [a]
++ IVar -> String
vn IVar
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->clone();\n"
           vn :: IVar -> String
           vn :: IVar -> String
vn (String
t, Int
0) = String -> String
varName String
t
           vn (String
t, Int
n) = String -> String
varName String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
           swapV :: IVar -> String
           swapV :: IVar -> String
swapV IVar
v = String
"  std::swap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IVar -> String
vn IVar
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", other." String -> String -> String
forall a. [a] -> [a] -> [a]
++ IVar -> String
vn IVar
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"

--The cloner makes a new deep copy of the object
prCloneC :: [UserDef] -> String -> [IVar] -> String
prCloneC :: [String] -> String -> [IVar] -> String
prCloneC [String]
_ String
c [IVar]
_ =
  String
c String -> String -> String
+++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::clone() const {" String -> String -> String
++++
    String
"  return new" String -> String -> String
+++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(*this);\n}"

--The destructor deletes all a class's members.
prDestructorC :: [UserDef] -> String -> [IVar] -> String
prDestructorC :: [String] -> String -> [IVar] -> String
prDestructorC [String]
user String
c [IVar]
vs  =
    String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"()" String -> String -> String
+++ String
"{" String -> String -> String
+++
    (IVar -> String) -> [IVar] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IVar -> String
prDeletes [IVar]
vs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
  where
    prDeletes :: (String, Int) -> String
    prDeletes :: IVar -> String
prDeletes (String
t, Int
n)
        | [String] -> String -> Bool
isBasic [String]
user String
t = String
""
        | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String
"delete(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
varName String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"); "
        | Bool
otherwise = String
"delete(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
varName String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"); "

--Prints the constructor's parameters.
prParams :: [Cat] -> Int -> Int -> [(String,String)]
prParams :: [Cat] -> Int -> Int -> [(String, String)]
prParams [] Int
_ Int
_ = []
prParams (Cat
c:[Cat]
cs) Int
n Int
m = (Cat -> String
identCat Cat
c, String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
                    (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [Cat] -> Int -> Int -> [(String, String)]
prParams [Cat]
cs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
m

--Prints the assignments of parameters to instance variables.
--This algorithm peeks ahead in the list so we don't use map or fold
prAssigns :: [IVar] -> [String] -> String
prAssigns :: [IVar] -> [String] -> String
prAssigns [] [String]
_ = []
prAssigns [IVar]
_ [] = []
prAssigns ((String
t,Int
n):[IVar]
vs) (String
p:[String]
ps) =
 if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then
  case (IVar -> Bool) -> [IVar] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (\(String
l,Int
_) -> String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
t) [IVar]
vs of
    [] -> String -> String
varName String
t String -> String -> String
+++ String
"=" String -> String -> String
+++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
+++ [IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
ps
    [Int]
_ -> String -> String
varName String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall {a}. (Eq a, Num a, Show a) => a -> String
showNum Int
n String -> String -> String
+++ String
"=" String -> String -> String
+++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
+++ [IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
ps
 else String -> String
varName String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall {a}. (Eq a, Num a, Show a) => a -> String
showNum Int
n String -> String -> String
+++ String
"=" String -> String -> String
+++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" String -> String -> String
+++ [IVar] -> [String] -> String
prAssigns [IVar]
vs [String]
ps


{- **** Helper Functions **** -}

-- | Checks if something is a basic or user-defined type.
isBasic :: [UserDef] -> String -> Bool
isBasic :: [String] -> String -> Bool
isBasic [String]
user String
x = String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
user Bool -> Bool -> Bool
|| String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
specialCatsP