{- -----------------------------------------------------------------------------
Copyright 2019-2021,2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE CPP #-}

module CompilerCxx.CxxFiles (
  CxxOutput(..),
  FileContext(..),
  generateMainFile,
  generateNativeConcrete,
  generateNativeInterface,
  generateStreamlinedExtension,
  generateStreamlinedTemplate,
  generateTestFile,
  generateVerboseExtension,
) where

import Control.Arrow (second)
import Data.List (intercalate,sortBy)
import Data.Hashable (hash)
import Prelude hiding (pi)
import qualified Data.Map as Map
import qualified Data.Set as Set

#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup
#endif

import Base.CompilerError
import Base.GeneralType
import Base.MergeTree
import Base.Positional
import Compilation.CompilerState
import Compilation.ProcedureContext (ExprMap)
import Compilation.ScopeContext
import CompilerCxx.CategoryContext
import CompilerCxx.Code
import CompilerCxx.Naming
import CompilerCxx.Procedure
import Module.CompileMetadata (CategorySpec(..))
import Types.Builtin
import Types.DefinedCategory
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance
import Types.Variance


data CxxOutput =
  CxxOutput {
    CxxOutput -> Maybe CategoryName
coCategory :: Maybe CategoryName,
    CxxOutput -> String
coFilename :: String,
    CxxOutput -> Namespace
coNamespace :: Namespace,
    CxxOutput -> Set Namespace
coUsesNamespace :: Set.Set Namespace,
    CxxOutput -> Set CategoryName
coUsesCategory :: Set.Set CategoryName,
    CxxOutput -> Set String
coPossibleTraces :: Set.Set String,
    CxxOutput -> [String]
coOutput :: [String]
  }
  deriving (Int -> CxxOutput -> ShowS
[CxxOutput] -> ShowS
CxxOutput -> String
(Int -> CxxOutput -> ShowS)
-> (CxxOutput -> String)
-> ([CxxOutput] -> ShowS)
-> Show CxxOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CxxOutput -> ShowS
showsPrec :: Int -> CxxOutput -> ShowS
$cshow :: CxxOutput -> String
show :: CxxOutput -> String
$cshowList :: [CxxOutput] -> ShowS
showList :: [CxxOutput] -> ShowS
Show)

data FileContext c =
  FileContext {
    forall c. FileContext c -> Bool
fcTesting :: Bool,
    forall c. FileContext c -> CategoryMap c
fcCategories :: CategoryMap c,
    forall c. FileContext c -> Set Namespace
fcNamespaces :: Set.Set Namespace,
    forall c. FileContext c -> ExprMap c
fcExprMap :: ExprMap c
  }

generateNativeConcrete :: (Ord c, Show c, CollectErrorsM m) =>
  FileContext c -> (AnyCategory c,DefinedCategory c) -> m [CxxOutput]
generateNativeConcrete :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
FileContext c
-> (AnyCategory c, DefinedCategory c) -> m [CxxOutput]
generateNativeConcrete (FileContext Bool
testing CategoryMap c
tm Set Namespace
ns ExprMap c
em) (AnyCategory c
t,DefinedCategory c
d) = do
  CxxOutput
dec <- Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing Set Namespace
ns AnyCategory c
t
  [CxxOutput]
def <- Bool -> CategoryDefinition c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (AnyCategory c
-> DefinedCategory c
-> CategoryMap c
-> Set Namespace
-> ExprMap c
-> CategoryDefinition c
forall c.
AnyCategory c
-> DefinedCategory c
-> CategoryMap c
-> Set Namespace
-> ExprMap c
-> CategoryDefinition c
NativeConcrete AnyCategory c
t DefinedCategory c
d CategoryMap c
tm Set Namespace
ns ExprMap c
em)
  [CxxOutput] -> m [CxxOutput]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
decCxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[CxxOutput]
def)

generateNativeInterface :: (Ord c, Show c, CollectErrorsM m) =>
  Bool -> Set.Set Namespace -> AnyCategory c -> m [CxxOutput]
generateNativeInterface :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
testing Set Namespace
ns AnyCategory c
t = do
  CxxOutput
dec <- Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing Set Namespace
ns AnyCategory c
t
  [CxxOutput]
def <- Bool -> CategoryDefinition c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (AnyCategory c -> CategoryDefinition c
forall c. AnyCategory c -> CategoryDefinition c
NativeInterface AnyCategory c
t)
  [CxxOutput] -> m [CxxOutput]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
decCxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[CxxOutput]
def)

generateStreamlinedExtension :: (Ord c, Show c, CollectErrorsM m) =>
  FileContext c -> AnyCategory c -> CategorySpec c -> m [CxxOutput]
generateStreamlinedExtension :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
FileContext c -> AnyCategory c -> CategorySpec c -> m [CxxOutput]
generateStreamlinedExtension (FileContext Bool
testing CategoryMap c
tm Set Namespace
ns ExprMap c
_) AnyCategory c
t CategorySpec c
spec = do
  CxxOutput
dec <- Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing Set Namespace
ns AnyCategory c
t
  [CxxOutput]
def <- Bool -> CategoryDefinition c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (CategoryName
-> CategoryMap c
-> Set Namespace
-> CategorySpec c
-> CategoryDefinition c
forall c.
CategoryName
-> CategoryMap c
-> Set Namespace
-> CategorySpec c
-> CategoryDefinition c
StreamlinedExtension (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) CategoryMap c
tm Set Namespace
ns CategorySpec c
spec)
  [CxxOutput] -> m [CxxOutput]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
decCxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[CxxOutput]
def)

generateVerboseExtension :: (Ord c, Show c, CollectErrorsM m) =>
  Bool -> AnyCategory c -> m [CxxOutput]
generateVerboseExtension :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> AnyCategory c -> m [CxxOutput]
generateVerboseExtension Bool
testing AnyCategory c
t =
  (CxxOutput -> [CxxOutput]) -> m CxxOutput -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[]) (m CxxOutput -> m [CxxOutput]) -> m CxxOutput -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing Set Namespace
forall a. Set a
Set.empty AnyCategory c
t

generateStreamlinedTemplate :: (Ord c, Show c, CollectErrorsM m) =>
  Bool -> CategoryMap c -> AnyCategory c -> CategorySpec c -> m [CxxOutput]
generateStreamlinedTemplate :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool
-> CategoryMap c
-> AnyCategory c
-> CategorySpec c
-> m [CxxOutput]
generateStreamlinedTemplate Bool
testing CategoryMap c
tm AnyCategory c
t CategorySpec c
spec =
  Bool -> CategoryDefinition c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (CategoryName
-> CategoryMap c -> CategorySpec c -> CategoryDefinition c
forall c.
CategoryName
-> CategoryMap c -> CategorySpec c -> CategoryDefinition c
StreamlinedTemplate (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) CategoryMap c
tm CategorySpec c
spec)

compileCategoryDeclaration :: (Ord c, Show c, CollectErrorsM m) =>
  Bool -> Set.Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing Set Namespace
ns AnyCategory c
t =
  CxxOutput -> m CxxOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                     (CategoryName -> String
headerFilename CategoryName
name)
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                     (CompiledData [String] -> Set CategoryName
forall s. CompiledData s -> Set CategoryName
cdRequired CompiledData [String]
file)
                     (CompiledData [String] -> Set String
forall s. CompiledData s -> Set String
cdTraces CompiledData [String]
file)
                     (CompiledData [String] -> [String]
forall s. CompiledData s -> s
cdOutput CompiledData [String]
file) where
    file :: CompiledData [String]
file = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat ([CompiledData [String]] -> CompiledData [String])
-> [CompiledData [String]] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
        Set CategoryName -> CompiledData [String]
onlyDeps Set CategoryName
depends,
        [String] -> CompiledData [String]
onlyCodes [String]
guardTop,
        [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ (if Bool
testing then CategoryName -> [String]
testsOnlyCategoryGuard (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) else []),
        [String] -> CompiledData [String]
onlyCodes [String]
baseHeaderIncludes,
        AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t CompiledData [String]
content,
        [String] -> CompiledData [String]
onlyCodes [String]
guardBottom
      ]
    depends :: Set CategoryName
depends = AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryDeps AnyCategory c
t
    content :: CompiledData [String]
content = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [CompiledData [String]
categoryId,CompiledData [String]
labels,CompiledData [String]
getCategory2,CompiledData [String]
getType]
    name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    guardTop :: [String]
guardTop = [String
"#ifndef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName,String
"#define " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardBottom :: [String]
guardBottom = [String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardName :: String
guardName = String
"HEADER_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardNamespace String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
name
    guardNamespace :: String
guardNamespace
      | Namespace -> Bool
isStaticNamespace (Namespace -> Bool) -> Namespace -> Bool
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = Namespace -> String
forall a. Show a => a -> String
show (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"
      | Bool
otherwise = String
""
    functions :: [ScopedFunction c]
functions = (ScopedFunction c -> ScopedFunction c -> Ordering)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ScopedFunction c -> ScopedFunction c -> Ordering
forall {c} {c}. ScopedFunction c -> ScopedFunction c -> Ordering
compareName ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryName
name) (CategoryName -> Bool)
-> (ScopedFunction c -> CategoryName) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
    compareName :: ScopedFunction c -> ScopedFunction c -> Ordering
compareName ScopedFunction c
x ScopedFunction c
y = ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
x FunctionName -> FunctionName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
y
    categoryFunctions :: [ScopedFunction c]
categoryFunctions = (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope) (SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
functions
    typeFunctions :: [ScopedFunction c]
typeFunctions = (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope) (SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
functions
    valueFunctions :: [ScopedFunction c]
valueFunctions = (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) (SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
functions
    labels :: CompiledData [String]
labels = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> String) -> [ScopedFunction c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> String
forall {c}. ScopedFunction c -> String
label ([ScopedFunction c] -> [String]) -> [ScopedFunction c] -> [String]
forall a b. (a -> b) -> a -> b
$ [ScopedFunction c]
categoryFunctions [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++ [ScopedFunction c]
typeFunctions [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++ [ScopedFunction c]
valueFunctions
    label :: ScopedFunction c -> String
label ScopedFunction c
f = String
"extern " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall {c}. ScopedFunction c -> String
functionLabelType ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall {c}. ScopedFunction c -> String
functionName ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    categoryId :: CompiledData [String]
categoryId = [String] -> CompiledData [String]
onlyCodes [
        String
"static constexpr CategoryId " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actualId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
      ]
    actualId :: Int
actualId = Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Hashable a => a -> Int
hash (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ [c] -> String
forall a. Show a => a -> String
show (AnyCategory c -> [c]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Namespace -> String
forall a. Show a => a -> String
show (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
    getCategory2 :: CompiledData [String]
getCategory2
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise             = AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareGetCategory AnyCategory c
t
    getType :: CompiledData [String]
getType
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise             = AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareGetType AnyCategory c
t

data CategoryDefinition c =
  NativeInterface {
    forall c. CategoryDefinition c -> AnyCategory c
niCategory :: AnyCategory c
  } |
  NativeConcrete {
    forall c. CategoryDefinition c -> AnyCategory c
ncCategory :: AnyCategory c,
    forall c. CategoryDefinition c -> DefinedCategory c
ncDefined :: DefinedCategory c,
    forall c. CategoryDefinition c -> CategoryMap c
ncCategories :: CategoryMap c,
    forall c. CategoryDefinition c -> Set Namespace
ncNamespaces :: Set.Set Namespace,
    forall c. CategoryDefinition c -> ExprMap c
ncExprMap :: ExprMap c
  } |
  StreamlinedExtension {
    forall c. CategoryDefinition c -> CategoryName
seType :: CategoryName,
    forall c. CategoryDefinition c -> CategoryMap c
seCategories :: CategoryMap c,
    forall c. CategoryDefinition c -> Set Namespace
seNamespaces :: Set.Set Namespace,
    forall c. CategoryDefinition c -> CategorySpec c
scSpec :: CategorySpec c
  } |
  StreamlinedTemplate {
    forall c. CategoryDefinition c -> CategoryName
stName :: CategoryName,
    forall c. CategoryDefinition c -> CategoryMap c
stCategories :: CategoryMap c,
    scSpec :: CategorySpec c
  }

generateCategoryDefinition :: (Ord c, Show c, CollectErrorsM m) =>
  Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing = CategoryDefinition c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryDefinition c -> m [CxxOutput]
common where
  common :: (Ord c, Show c, CollectErrorsM m) => CategoryDefinition c -> m [CxxOutput]
  common :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryDefinition c -> m [CxxOutput]
common (NativeInterface AnyCategory c
t) = (CxxOutput -> [CxxOutput]) -> m CxxOutput -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[]) m CxxOutput
singleSource where
    singleSource :: m CxxOutput
singleSource = do
      let filename :: String
filename = CategoryName -> String
sourceFilename (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
      let ([ScopedFunction c]
cf,[ScopedFunction c]
tf,[ScopedFunction c]
vf) = (ScopedFunction c -> SymbolScope)
-> [ScopedFunction c]
-> ([ScopedFunction c], [ScopedFunction c], [ScopedFunction c])
forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ([ScopedFunction c]
 -> ([ScopedFunction c], [ScopedFunction c], [ScopedFunction c]))
-> [ScopedFunction c]
-> ([ScopedFunction c], [ScopedFunction c], [ScopedFunction c])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
      (CompiledData Set CategoryName
req Set String
traces [String]
out) <- (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
          AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
defineFunctions AnyCategory c
t [ScopedFunction c]
cf [ScopedFunction c]
tf [ScopedFunction c]
vf,
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareInternalGetters AnyCategory c
t,
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInterfaceCategory AnyCategory c
t,
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInterfaceType     AnyCategory c
t,
          AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineCategoryOverrides AnyCategory c
t [],
          AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineTypeOverrides     AnyCategory c
t [],
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInternalGetters AnyCategory c
t,
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineExternalGetters AnyCategory c
t
        ]
      let req' :: Set CategoryName
req' = Set CategoryName
req Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t
      CxxOutput -> m CxxOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                         String
filename
                         (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                         ([Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList [AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t])
                         Set CategoryName
req'
                         Set String
traces
                         ([String] -> [String]
allowTestsOnly ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
addSourceIncludes ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [String] -> [String]
forall {c}. AnyCategory c -> [String] -> [String]
addCategoryHeader AnyCategory c
t ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [String] -> [String]
addIncludes Set CategoryName
req' [String]
out)
  common (StreamlinedExtension CategoryName
n CategoryMap c
ta Set Namespace
ns (CategorySpec [c]
c [ValueRefine c]
rs [ValueDefine c]
ds)) = do
    CategoryMap c
ta' <- CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance CategoryMap c
ta DefinedCategory c
defined
    ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
ta' ([],CategoryName
n)
    [m CxxOutput] -> m [CxxOutput]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [AnyCategory c -> m CxxOutput
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m CxxOutput
streamlinedHeader AnyCategory c
t,AnyCategory c -> m CxxOutput
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m CxxOutput
streamlinedSource AnyCategory c
t] where
      defined :: DefinedCategory c
defined = DefinedCategory {
          dcContext :: [c]
dcContext = [c]
c,
          dcPragmas :: [PragmaDefined c]
dcPragmas = [],
          dcName :: CategoryName
dcName = CategoryName
n,
          dcRefines :: [ValueRefine c]
dcRefines = [ValueRefine c]
rs,
          dcDefines :: [ValueDefine c]
dcDefines = [ValueDefine c]
ds,
          dcMembers :: [DefinedMember c]
dcMembers = [],
          dcProcedures :: [ExecutableProcedure c]
dcProcedures = [],
          dcFunctions :: [ScopedFunction c]
dcFunctions = []
        }
      streamlinedHeader :: AnyCategory c -> m CxxOutput
streamlinedHeader AnyCategory c
t = do
        let filename :: String
filename = CategoryName -> String
headerStreamlined CategoryName
n
        let maybeValue :: [m (CompiledData [String])]
maybeValue = if CategoryName -> Bool
hasPrimitiveValue CategoryName
n
                            then []
                            else [AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineAbstractValue AnyCategory c
t]
        (CompiledData Set CategoryName
req Set String
traces [String]
out) <- (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [
            AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineAbstractCategory AnyCategory c
t,
            CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Int -> CompiledData [String]
forall c. AnyCategory c -> Int -> CompiledData [String]
declareInternalType AnyCategory c
t ([ValueParam c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t),
            AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineAbstractType AnyCategory c
t
          ] [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeValue [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [
            AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareAbstractGetters AnyCategory c
t
          ]
        CxxOutput -> m CxxOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ CategoryName
n)
                           String
filename
                           (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                           (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                           Set CategoryName
req
                           Set String
traces
                           (CategoryName -> [String] -> [String]
forall {p}. Show p => p -> [String] -> [String]
headerGuard CategoryName
n ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
allowTestsOnly ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
addTemplateIncludes ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [String] -> [String]
forall {c}. AnyCategory c -> [String] -> [String]
addCategoryHeader AnyCategory c
t ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [String] -> [String]
addIncludes Set CategoryName
req [String]
out)
      streamlinedSource :: AnyCategory c -> m CxxOutput
streamlinedSource AnyCategory c
t = do
        let filename :: String
filename = CategoryName -> String
sourceStreamlined CategoryName
n
        let ([ScopedFunction c]
cf,[ScopedFunction c]
tf,[ScopedFunction c]
vf) = (ScopedFunction c -> SymbolScope)
-> [ScopedFunction c]
-> ([ScopedFunction c], [ScopedFunction c], [ScopedFunction c])
forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ([ScopedFunction c]
 -> ([ScopedFunction c], [ScopedFunction c], [ScopedFunction c]))
-> [ScopedFunction c]
-> ([ScopedFunction c], [ScopedFunction c], [ScopedFunction c])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
        let maybeValue :: [m (CompiledData [String])]
maybeValue = if CategoryName -> Bool
hasPrimitiveValue CategoryName
n
                            then []
                            else [AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineValueOverrides AnyCategory c
t (AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t)]
        (CompiledData Set CategoryName
req Set String
traces [String]
out) <- (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [
            AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
defineFunctions AnyCategory c
t [ScopedFunction c]
cf [ScopedFunction c]
tf [ScopedFunction c]
vf,
            AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineCategoryOverrides AnyCategory c
t (AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t),
            AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineTypeOverrides     AnyCategory c
t (AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t)
          ] [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeValue [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [
            AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineExternalGetters AnyCategory c
t
          ]
        let req' :: Set CategoryName
req' = [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName
req,AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t]
        CxxOutput -> m CxxOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ CategoryName
n)
                           String
filename
                           (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                           (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                           Set CategoryName
req'
                           Set String
traces
                           ([String] -> [String]
addSourceIncludes ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [String] -> [String]
forall {c}. AnyCategory c -> [String] -> [String]
addStreamlinedHeader AnyCategory c
t ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [String] -> [String]
addIncludes Set CategoryName
req' [String]
out)
  common (StreamlinedTemplate CategoryName
n CategoryMap c
tm (CategorySpec [c]
c [ValueRefine c]
rs [ValueDefine c]
ds)) = (CxxOutput -> [CxxOutput]) -> m CxxOutput -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[]) m CxxOutput
streamlinedTemplate where
    streamlinedTemplate :: m CxxOutput
streamlinedTemplate = do
      CategoryMap c
tm' <- CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance CategoryMap c
tm DefinedCategory c
defined0
      ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
tm' ([],CategoryName
n)
      [ProcedureScope c
cp,ProcedureScope c
tp,ProcedureScope c
vp] <- CategoryMap c
-> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
getProcedureScopes CategoryMap c
tm' ExprMap c
forall k a. Map k a
Map.empty ([ScopedFunction c] -> DefinedCategory c
forall {c}. Show c => [ScopedFunction c] -> DefinedCategory c
defined ([ScopedFunction c] -> DefinedCategory c)
-> [ScopedFunction c] -> DefinedCategory c
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t)
      let maybeGetter :: [m (CompiledData [String])]
maybeGetter = if CategoryName -> Bool
hasPrimitiveValue (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                           then []
                           else [AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareCustomValueGetter AnyCategory c
t]
      let maybeGetter2 :: [m (CompiledData [String])]
maybeGetter2 = if CategoryName -> Bool
hasPrimitiveValue (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                            then []
                            else [AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineCustomValueGetter AnyCategory c
t]
      let maybeValue :: [m (CompiledData [String])]
maybeValue = if CategoryName -> Bool
hasPrimitiveValue (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                          then []
                          else [AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomValue AnyCategory c
t ProcedureScope c
vp]
      (CompiledData Set CategoryName
req Set String
traces [String]
out) <- (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$
        [m (CompiledData [String])]
maybeGetter [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [
          AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomCategory AnyCategory c
t ProcedureScope c
cp,
          AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomType     AnyCategory c
t ProcedureScope c
tp
        ] [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeValue [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineCustomGetters AnyCategory c
t
        ] [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeGetter2
      let req' :: Set CategoryName
req' = [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName
req,AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t]
      CxxOutput -> m CxxOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                         String
filename
                         (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                         ([Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList [AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t])
                         Set CategoryName
req'
                         Set String
traces
                         ([String] -> [String]
addTemplateIncludes ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [String] -> [String]
forall {c}. AnyCategory c -> [String] -> [String]
addStreamlinedHeader AnyCategory c
t ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [String] -> [String]
addIncludes Set CategoryName
req' [String]
out)
    filename :: String
filename = CategoryName -> String
templateStreamlined CategoryName
n
    defined0 :: DefinedCategory c
defined0 = DefinedCategory {
        dcContext :: [c]
dcContext = [c]
c,
        dcPragmas :: [PragmaDefined c]
dcPragmas = [],
        dcName :: CategoryName
dcName = CategoryName
n,
        dcRefines :: [ValueRefine c]
dcRefines = [ValueRefine c]
rs,
        dcDefines :: [ValueDefine c]
dcDefines = [ValueDefine c]
ds,
        dcMembers :: [DefinedMember c]
dcMembers = [],
        dcProcedures :: [ExecutableProcedure c]
dcProcedures = [],
        dcFunctions :: [ScopedFunction c]
dcFunctions = []
      }
    defined :: [ScopedFunction c] -> DefinedCategory c
defined [ScopedFunction c]
fs = DefinedCategory {
        dcContext :: [c]
dcContext = [],
        dcPragmas :: [PragmaDefined c]
dcPragmas = [],
        dcName :: CategoryName
dcName = CategoryName
n,
        dcRefines :: [ValueRefine c]
dcRefines = [ValueRefine c]
rs,
        dcDefines :: [ValueDefine c]
dcDefines = [ValueDefine c]
ds,
        dcMembers :: [DefinedMember c]
dcMembers = [],
        dcProcedures :: [ExecutableProcedure c]
dcProcedures = (ScopedFunction c -> ExecutableProcedure c)
-> [ScopedFunction c] -> [ExecutableProcedure c]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> ExecutableProcedure c
forall {c} {c}. Show c => ScopedFunction c -> ExecutableProcedure c
defaultFail [ScopedFunction c]
fs,
        dcFunctions :: [ScopedFunction c]
dcFunctions = []
      }
    defaultFail :: ScopedFunction c -> ExecutableProcedure c
defaultFail ScopedFunction c
f = ExecutableProcedure {
        epContext :: [c]
epContext = [],
        epPragmas :: [PragmaProcedure c]
epPragmas = [],
        epEnd :: [c]
epEnd = [],
        epName :: FunctionName
epName = ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,
        epArgs :: ArgValues c
epArgs = [c] -> Positional (InputValue c) -> ArgValues c
forall c. [c] -> Positional (InputValue c) -> ArgValues c
ArgValues [] (Positional (InputValue c) -> ArgValues c)
-> Positional (InputValue c) -> ArgValues c
forall a b. (a -> b) -> a -> b
$ [InputValue c] -> Positional (InputValue c)
forall a. [a] -> Positional a
Positional ([InputValue c] -> Positional (InputValue c))
-> [InputValue c] -> Positional (InputValue c)
forall a b. (a -> b) -> a -> b
$ (Int -> InputValue c) -> [Int] -> [InputValue c]
forall a b. (a -> b) -> [a] -> [b]
map Int -> InputValue c
forall {c}. Int -> InputValue c
createArg [Int
1..([(PassedValue c, Maybe (CallArgLabel c))] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(PassedValue c, Maybe (CallArgLabel c))] -> Int)
-> [(PassedValue c, Maybe (CallArgLabel c))] -> Int
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a. Positional a -> [a]
pValues (Positional (PassedValue c, Maybe (CallArgLabel c))
 -> [(PassedValue c, Maybe (CallArgLabel c))])
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f)],
        epReturns :: ReturnValues c
epReturns = [c] -> ReturnValues c
forall c. [c] -> ReturnValues c
UnnamedReturns [],
        epProcedure :: Procedure c
epProcedure = ScopedFunction c -> Procedure c
forall {c} {c}. Show c => ScopedFunction c -> Procedure c
failProcedure ScopedFunction c
f
      }
    createArg :: Int -> InputValue c
createArg = [c] -> VariableName -> InputValue c
forall c. [c] -> VariableName -> InputValue c
InputValue [] (VariableName -> InputValue c)
-> (Int -> VariableName) -> Int -> InputValue c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VariableName
VariableName (String -> VariableName) -> (Int -> String) -> Int -> VariableName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"arg" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
    failProcedure :: ScopedFunction c -> Procedure c
failProcedure ScopedFunction c
f = [c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [] ([Statement c] -> Procedure c) -> [Statement c] -> Procedure c
forall a b. (a -> b) -> a -> b
$ [
        String -> Statement c
forall {c}. String -> Statement c
asLineComment (String -> Statement c) -> String -> Statement c
forall a b. (a -> b) -> a -> b
$ String
"TODO: Implement " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> ScopedFunction c -> String
forall c. CategoryName -> ScopedFunction c -> String
functionDebugName CategoryName
n ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
      ] [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ (String -> Statement c) -> [String] -> [Statement c]
forall a b. (a -> b) -> [a] -> [b]
map String -> Statement c
forall {c}. String -> Statement c
asLineComment (ScopedFunction c -> [String]
forall c. Show c => ScopedFunction c -> [String]
formatFunctionTypes ScopedFunction c
f) [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [
        String -> Statement c
forall {c}. String -> Statement c
RawFailCall (CategoryName -> ScopedFunction c -> String
forall c. CategoryName -> ScopedFunction c -> String
functionDebugName CategoryName
n ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not implemented (see " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
      ]
    asLineComment :: String -> Statement c
asLineComment = [c] -> VoidExpression c -> Statement c
forall c. [c] -> VoidExpression c -> Statement c
NoValueExpression [] (VoidExpression c -> Statement c)
-> (String -> VoidExpression c) -> String -> Statement c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VoidExpression c
forall c. String -> VoidExpression c
LineComment
  common (NativeConcrete AnyCategory c
t d :: DefinedCategory c
d@(DefinedCategory [c]
_ CategoryName
_ [PragmaDefined c]
_ [ValueRefine c]
_ [ValueDefine c]
_ [DefinedMember c]
ms [ExecutableProcedure c]
_ [ScopedFunction c]
_) CategoryMap c
ta Set Namespace
ns ExprMap c
em) = (CxxOutput -> [CxxOutput]) -> m CxxOutput -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[]) m CxxOutput
singleSource where
    singleSource :: m CxxOutput
singleSource = do
      let filename :: String
filename = CategoryName -> String
sourceFilename (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
      CategoryMap c
ta' <- CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance CategoryMap c
ta DefinedCategory c
d
      let r :: CategoryResolver c
r = CategoryMap c -> CategoryResolver c
forall c. CategoryMap c -> CategoryResolver c
CategoryResolver CategoryMap c
ta'
      [ProcedureScope c
cp,ProcedureScope c
tp,ProcedureScope c
vp] <- CategoryMap c
-> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
getProcedureScopes CategoryMap c
ta' ExprMap c
em DefinedCategory c
d
      let ([DefinedMember c]
_,[DefinedMember c]
tm,[DefinedMember c]
_) = (DefinedMember c -> SymbolScope)
-> [DefinedMember c]
-> ([DefinedMember c], [DefinedMember c], [DefinedMember c])
forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope [DefinedMember c]
ms
      [DefinedMember c] -> m ()
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
[DefinedMember c] -> m ()
disallowTypeMembers [DefinedMember c]
tm
      Set ParamName
params <- AnyCategory c -> m (Set ParamName)
forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m (Set ParamName)
getCategoryParamSet AnyCategory c
t
      let cf :: [ScopedFunction c]
cf = ((ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c)
-> [(ScopedFunction c, ExecutableProcedure c)]
-> [ScopedFunction c]
forall a b. (a -> b) -> [a] -> [b]
map (ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c
forall a b. (a, b) -> a
fst ([(ScopedFunction c, ExecutableProcedure c)] -> [ScopedFunction c])
-> [(ScopedFunction c, ExecutableProcedure c)]
-> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
forall c.
ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures ProcedureScope c
cp
      let tf :: [ScopedFunction c]
tf = ((ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c)
-> [(ScopedFunction c, ExecutableProcedure c)]
-> [ScopedFunction c]
forall a b. (a -> b) -> [a] -> [b]
map (ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c
forall a b. (a, b) -> a
fst ([(ScopedFunction c, ExecutableProcedure c)] -> [ScopedFunction c])
-> [(ScopedFunction c, ExecutableProcedure c)]
-> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
forall c.
ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures ProcedureScope c
tp
      let vf :: [ScopedFunction c]
vf = ((ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c)
-> [(ScopedFunction c, ExecutableProcedure c)]
-> [ScopedFunction c]
forall a b. (a -> b) -> [a] -> [b]
map (ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c
forall a b. (a, b) -> a
fst ([(ScopedFunction c, ExecutableProcedure c)] -> [ScopedFunction c])
-> [(ScopedFunction c, ExecutableProcedure c)]
-> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
forall c.
ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures ProcedureScope c
vp
      (CompiledData Set CategoryName
req Set String
traces [String]
out) <- (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
          AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
defineFunctions AnyCategory c
t [ScopedFunction c]
cf [ScopedFunction c]
tf [ScopedFunction c]
vf,
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareInternalGetters AnyCategory c
t,
          CategoryResolver c
-> [ScopedFunction c]
-> CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> m (CompiledData [String])
forall {m :: * -> *} {c} {r} {c}.
(CollectErrorsM m, Show c, Ord c, TypeResolver r) =>
r
-> [ScopedFunction c]
-> CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> m (CompiledData [String])
defineConcreteCategory CategoryResolver c
r [ScopedFunction c]
cf CategoryMap c
ta' ExprMap c
em AnyCategory c
t DefinedCategory c
d,
          [ScopedFunction c] -> AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
CollectErrorsM m =>
[ScopedFunction c] -> AnyCategory c -> m (CompiledData [String])
defineConcreteType [ScopedFunction c]
tf AnyCategory c
t,
          CategoryResolver c
-> Set ParamName
-> [ScopedFunction c]
-> AnyCategory c
-> DefinedCategory c
-> m (CompiledData [String])
forall {m :: * -> *} {c} {r} {c} {c}.
(CollectErrorsM m, Show c, TypeResolver r) =>
r
-> Set ParamName
-> [ScopedFunction c]
-> AnyCategory c
-> DefinedCategory c
-> m (CompiledData [String])
defineConcreteValue CategoryResolver c
r Set ParamName
params [ScopedFunction c]
vf AnyCategory c
t DefinedCategory c
d,
          AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineCategoryOverrides AnyCategory c
t [ScopedFunction c]
cf,
          AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineTypeOverrides     AnyCategory c
t [ScopedFunction c]
tf,
          AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineValueOverrides    AnyCategory c
t [ScopedFunction c]
vf,
          AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCategoryFunctions AnyCategory c
t ProcedureScope c
cp,
          AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineTypeFunctions     AnyCategory c
t ProcedureScope c
tp,
          AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineValueFunctions    AnyCategory c
t ProcedureScope c
vp,
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInternalGetters AnyCategory c
t,
          AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineExternalGetters AnyCategory c
t
        ]
      let req' :: Set CategoryName
req' = [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName
req,AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t]
      CxxOutput -> m CxxOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                         String
filename
                         (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                         (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                         Set CategoryName
req'
                         Set String
traces
                         ([String] -> [String]
allowTestsOnly ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
addSourceIncludes ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [String] -> [String]
forall {c}. AnyCategory c -> [String] -> [String]
addCategoryHeader AnyCategory c
t ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [String] -> [String]
addIncludes Set CategoryName
req' [String]
out)

  defineFunctions :: AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
defineFunctions AnyCategory c
t [ScopedFunction c]
cf [ScopedFunction c]
tf [ScopedFunction c]
vf = m (CompiledData [String])
createAllLabels where
    name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    createAllLabels :: m (CompiledData [String])
createAllLabels = CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ([ScopedFunction c] -> [String])
-> [[ScopedFunction c]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map [ScopedFunction c] -> [String]
forall {c}. [ScopedFunction c] -> [String]
createLabels [[ScopedFunction c]
cf,[ScopedFunction c]
tf,[ScopedFunction c]
vf]
    createLabels :: [ScopedFunction c] -> [String]
createLabels = ((Int, ScopedFunction c) -> String)
-> [(Int, ScopedFunction c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> ScopedFunction c -> String)
-> (Int, ScopedFunction c) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ScopedFunction c -> String
forall c. Int -> ScopedFunction c -> String
createLabelForFunction) ([(Int, ScopedFunction c)] -> [String])
-> ([ScopedFunction c] -> [(Int, ScopedFunction c)])
-> [ScopedFunction c]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [ScopedFunction c] -> [(Int, ScopedFunction c)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([ScopedFunction c] -> [(Int, ScopedFunction c)])
-> ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c]
-> [(Int, ScopedFunction c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c -> ScopedFunction c -> Ordering)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ScopedFunction c -> ScopedFunction c -> Ordering
forall {c} {c}. ScopedFunction c -> ScopedFunction c -> Ordering
compareName ([ScopedFunction c] -> [ScopedFunction c])
-> ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c]
-> [ScopedFunction c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryName
name) (CategoryName -> Bool)
-> (ScopedFunction c -> CategoryName) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType)
    compareName :: ScopedFunction c -> ScopedFunction c -> Ordering
compareName ScopedFunction c
x ScopedFunction c
y = ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
x FunctionName -> FunctionName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
y

  declareInternalGetters :: AnyCategory c -> m (CompiledData [String])
declareInternalGetters AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareInternalCategory AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Int -> CompiledData [String]
forall c. AnyCategory c -> Int -> CompiledData [String]
declareInternalType AnyCategory c
t ([ValueParam c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t),
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ CompiledData [String]
valueGetter
    ] where
      valueGetter :: CompiledData [String]
valueGetter
        | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete AnyCategory c
t = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
            String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
            AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareInternalValue AnyCategory c
t
          ]
        | Bool
otherwise = CompiledData [String]
emptyCode
  defineInternalGetters :: AnyCategory c -> m (CompiledData [String])
defineInternalGetters AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
defineInternalCategory AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Int -> CompiledData [String]
forall c. AnyCategory c -> Int -> CompiledData [String]
defineInternalType AnyCategory c
t ([ValueParam c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t),
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ CompiledData [String]
valueGetter
    ] where
      valueGetter :: CompiledData [String]
valueGetter
        | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete AnyCategory c
t = AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
defineInternalValue AnyCategory c
t
        | Bool
otherwise = CompiledData [String]
emptyCode

  declareCustomValueGetter :: AnyCategory c -> m (CompiledData [String])
declareCustomValueGetter AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareInternalValue AnyCategory c
t
    ]
  defineCustomValueGetter :: AnyCategory c -> m (CompiledData [String])
defineCustomValueGetter AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> AnyCategory c -> CompiledData [String]
forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalValue2 (CategoryName -> String
valueCustom (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) AnyCategory c
t
    ]

  declareAbstractGetters :: AnyCategory c -> m (CompiledData [String])
declareAbstractGetters AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareInternalCategory AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Int -> CompiledData [String]
forall c. AnyCategory c -> Int -> CompiledData [String]
declareInternalType AnyCategory c
t ([ValueParam c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t)
    ]

  defineExternalGetters :: AnyCategory c -> m (CompiledData [String])
defineExternalGetters AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
defineGetCatetory AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
defineGetType     AnyCategory c
t
    ]
  defineCustomGetters :: AnyCategory c -> m (CompiledData [String])
defineCustomGetters AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> AnyCategory c -> CompiledData [String]
forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalCategory2 (CategoryName -> String
categoryCustom (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)) AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> AnyCategory c -> Int -> CompiledData [String]
forall c. String -> AnyCategory c -> Int -> CompiledData [String]
defineInternalType2     (CategoryName -> String
typeCustom     (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)) AnyCategory c
t ([ValueParam c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t)
    ]

  defineInterfaceCategory :: AnyCategory c -> m (CompiledData [String])
defineInterfaceCategory AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
categoryBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareCategoryOverrides,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]
  defineInterfaceType :: AnyCategory c -> m (CompiledData [String])
defineInterfaceType AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ Bool -> AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
Bool -> AnyCategory c -> m (CompiledData [String])
inlineTypeDestructor Bool
False AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareTypeOverrides,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [ValueParam c] -> CompiledData [String]
forall {c}. [ValueParam c] -> CompiledData [String]
createParams ([ValueParam c] -> CompiledData [String])
-> [ValueParam c] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& parent;",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]

  defineConcreteCategory :: r
-> [ScopedFunction c]
-> CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> m (CompiledData [String])
defineConcreteCategory r
r [ScopedFunction c]
fs CategoryMap c
tm ExprMap c
em AnyCategory c
t DefinedCategory c
d = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
categoryBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c
-> DefinedCategory c
-> CategoryMap c
-> ExprMap c
-> m (CompiledData [String])
forall {m :: * -> *} {c}.
(CollectErrorsM m, Show c, Ord c) =>
AnyCategory c
-> DefinedCategory c
-> CategoryMap c
-> ExprMap c
-> m (CompiledData [String])
inlineCategoryConstructor AnyCategory c
t DefinedCategory c
d CategoryMap c
tm ExprMap c
em,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareCategoryOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
False) [ScopedFunction c]
fs,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> m (CompiledData [String]))
-> [DefinedMember c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (r -> DefinedMember c -> m (CompiledData [String])
forall {m :: * -> *} {c} {r}.
(Show c, CollectErrorsM m, TypeResolver r) =>
r -> DefinedMember c -> m (CompiledData [String])
createMemberLazy r
r) [DefinedMember c]
members,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      members :: [DefinedMember c]
members = (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope)(SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember c] -> [DefinedMember c])
-> [DefinedMember c] -> [DefinedMember c]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d

  defineConcreteType :: [ScopedFunction c] -> AnyCategory c -> m (CompiledData [String])
defineConcreteType [ScopedFunction c]
fs AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", std::enable_shared_from_this<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ Bool -> AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
Bool -> AnyCategory c -> m (CompiledData [String])
inlineTypeDestructor Bool
False AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeParamSelf AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareTypeOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
False) [ScopedFunction c]
fs,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [ValueParam c] -> CompiledData [String]
forall {c}. [ValueParam c] -> CompiledData [String]
createParams ([ValueParam c] -> CompiledData [String])
-> [ValueParam c] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& parent;",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      className :: String
className = CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)

  defineConcreteValue :: r
-> Set ParamName
-> [ScopedFunction c]
-> AnyCategory c
-> DefinedCategory c
-> m (CompiledData [String])
defineConcreteValue r
r Set ParamName
params [ScopedFunction c]
fs AnyCategory c
t DefinedCategory c
d = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
valueBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> DefinedCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c -> DefinedCategory c -> m (CompiledData [String])
inlineValueConstructor AnyCategory c
t DefinedCategory c
d,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineValueParamSelf AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> m (CompiledData [String])
forall {a} {m :: * -> *}.
(Show a, CollectErrorsM m) =>
DefinedCategory a -> m (CompiledData [String])
inlineFlatCleanup DefinedCategory c
d,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareValueOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
False) [ScopedFunction c]
fs,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> m (CompiledData [String]))
-> [DefinedMember c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (r
-> Set ParamName
-> AnyCategory c
-> DefinedMember c
-> m (CompiledData [String])
forall {m :: * -> *} {c} {r} {c}.
(Show c, CollectErrorsM m, TypeResolver r) =>
r
-> Set ParamName
-> AnyCategory c
-> DefinedMember c
-> m (CompiledData [String])
createMember r
r Set ParamName
params AnyCategory c
t) [DefinedMember c]
members,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  const S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> parent;",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
traceCreation,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      members :: [DefinedMember c]
members = (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope)(SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember c] -> [DefinedMember c])
-> [DefinedMember c] -> [DefinedMember c]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d
      procedures :: [ExecutableProcedure c]
procedures = DefinedCategory c -> [ExecutableProcedure c]
forall c. DefinedCategory c -> [ExecutableProcedure c]
dcProcedures DefinedCategory c
d
      traceCreation :: [String]
traceCreation
        | (PragmaProcedure c -> Bool) -> [PragmaProcedure c] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PragmaProcedure c -> Bool
forall c. PragmaProcedure c -> Bool
isTraceCreation ([PragmaProcedure c] -> Bool) -> [PragmaProcedure c] -> Bool
forall a b. (a -> b) -> a -> b
$ [[PragmaProcedure c]] -> [PragmaProcedure c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PragmaProcedure c]] -> [PragmaProcedure c])
-> [[PragmaProcedure c]] -> [PragmaProcedure c]
forall a b. (a -> b) -> a -> b
$ (ExecutableProcedure c -> [PragmaProcedure c])
-> [ExecutableProcedure c] -> [[PragmaProcedure c]]
forall a b. (a -> b) -> [a] -> [b]
map ExecutableProcedure c -> [PragmaProcedure c]
forall c. ExecutableProcedure c -> [PragmaProcedure c]
epPragmas [ExecutableProcedure c]
procedures = [CategoryName -> String
captureCreationTrace (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t]
        | Bool
otherwise = []

  defineAbstractCategory :: AnyCategory c -> m (CompiledData [String])
defineAbstractCategory AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
categoryBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareCategoryOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
True) ([ScopedFunction c] -> [m (CompiledData [String])])
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope)(SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  virtual inline ~" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() {}",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]

  defineAbstractType :: AnyCategory c -> m (CompiledData [String])
defineAbstractType AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", std::enable_shared_from_this<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ Bool -> AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
Bool -> AnyCategory c -> m (CompiledData [String])
inlineTypeDestructor Bool
True AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeParamSelf AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareTypeOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
True) ([ScopedFunction c] -> [m (CompiledData [String])])
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope)(SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [ValueParam c] -> CompiledData [String]
forall {c}. [ValueParam c] -> CompiledData [String]
createParams ([ValueParam c] -> CompiledData [String])
-> [ValueParam c] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& parent;",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      className :: String
className = CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)

  defineAbstractValue :: AnyCategory c -> m (CompiledData [String])
defineAbstractValue AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
valueBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
abstractValueConstructor AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineValueParamSelf AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareValueOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
True) ([ScopedFunction c] -> [m (CompiledData [String])])
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope)(SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  virtual inline ~" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() {}",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  const S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> parent;",
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]

  defineCustomCategory :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
  defineCustomCategory :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomCategory AnyCategory c
t ProcedureScope c
ps = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCustom (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> ProcedureScope c -> [m (CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall {c} {m :: * -> *} {c}.
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
defineProcedure AnyCategory c
t CxxFunctionType
FinalInlineFunction) ProcedureScope c
ps,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]
  defineCustomType :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
  defineCustomType :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomType AnyCategory c
t ProcedureScope c
ps = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCustom (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
customTypeConstructor AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> ProcedureScope c -> [m (CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall {c} {m :: * -> *} {c}.
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
defineProcedure AnyCategory c
t CxxFunctionType
FinalInlineFunction) ProcedureScope c
ps,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]
  defineCustomValue :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
  defineCustomValue :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomValue AnyCategory c
t ProcedureScope c
ps = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCustom (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
customValueConstructor AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> ProcedureScope c -> [m (CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall {c} {m :: * -> *} {c}.
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
defineProcedure AnyCategory c
t CxxFunctionType
FinalInlineFunction) ProcedureScope c
ps,
      CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]

  defineCategoryFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
  defineCategoryFunctions :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCategoryFunctions AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> (ProcedureScope c -> [m (CompiledData [String])])
-> ProcedureScope c
-> m (CompiledData [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> ProcedureScope c -> [m (CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall {c} {m :: * -> *} {c}.
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
defineProcedure AnyCategory c
t (CxxFunctionType
 -> ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CxxFunctionType
OutOfLineFunction (String -> CxxFunctionType) -> String -> CxxFunctionType
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
categoryName (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
  defineTypeFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
  defineTypeFunctions :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineTypeFunctions AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> (ProcedureScope c -> [m (CompiledData [String])])
-> ProcedureScope c
-> m (CompiledData [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> ProcedureScope c -> [m (CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall {c} {m :: * -> *} {c}.
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
defineProcedure AnyCategory c
t (CxxFunctionType
 -> ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CxxFunctionType
OutOfLineFunction (String -> CxxFunctionType) -> String -> CxxFunctionType
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
typeName (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
  defineValueFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
  defineValueFunctions :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineValueFunctions AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> (ProcedureScope c -> [m (CompiledData [String])])
-> ProcedureScope c
-> m (CompiledData [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> ProcedureScope c -> [m (CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall {c} {m :: * -> *} {c}.
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
defineProcedure AnyCategory c
t (CxxFunctionType
 -> ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String]))
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CxxFunctionType
OutOfLineFunction (String -> CxxFunctionType) -> String -> CxxFunctionType
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
valueName (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)

  declareCategoryOverrides :: CompiledData [String]
declareCategoryOverrides = [String] -> CompiledData [String]
onlyCodes [
      String
"  std::string CategoryName() const final;",
      String
"  ReturnTuple Dispatch(const CategoryFunction& label, const ParamsArgs& params_args) final;"
    ]
  declareTypeOverrides :: CompiledData [String]
declareTypeOverrides = [String] -> CompiledData [String]
onlyCodes [
      String
"  std::string CategoryName() const final;",
      String
"  void BuildTypeName(std::ostream& output) const final;",
      String
"  bool TypeArgsForParent(const CategoryId& category, std::vector<S<const TypeInstance>>& args) const final;",
      String
"  ReturnTuple Dispatch(const TypeFunction& label, const ParamsArgs& params_args) const final;",
      String
"  bool CanConvertFrom(const S<const TypeInstance>& from) const final;"
    ]
  declareValueOverrides :: CompiledData [String]
declareValueOverrides = [String] -> CompiledData [String]
onlyCodes [
      String
"  std::string CategoryName() const final;",
      String
"  ReturnTuple Dispatch(const ValueFunction& label, const ParamsArgs& params_args) final;"
    ]

  defineCategoryOverrides :: AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineCategoryOverrides AnyCategory c
t [ScopedFunction c]
fs = CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"std::string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::CategoryName() const { return \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"; }",
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::Dispatch(const CategoryFunction& label, const ParamsArgs& params_args) {",
      AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
forall c.
AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch AnyCategory c
t SymbolScope
CategoryScope [ScopedFunction c]
fs,
      String -> CompiledData [String]
onlyCode String
"}"
    ] where
      className :: String
className = CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
  defineTypeOverrides :: AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineTypeOverrides AnyCategory c
t [ScopedFunction c]
fs = do
    CompiledData [String]
typeArgs <- AnyCategory c -> m (CompiledData [String])
forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
createTypeArgsForParent AnyCategory c
t
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"std::string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::CategoryName() const { return parent.CategoryName(); }",
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"void " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::BuildTypeName(std::ostream& output) const {",
        [ParamName] -> CompiledData [String]
defineTypeName [ParamName]
params,
        String -> CompiledData [String]
onlyCode String
"}",
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"bool " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::TypeArgsForParent(const CategoryId& category, std::vector<S<const TypeInstance>>& args) const {",
        CompiledData [String]
typeArgs,
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"}",
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::Dispatch(const TypeFunction& label, const ParamsArgs& params_args) const {",
        AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
forall c.
AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch AnyCategory c
t SymbolScope
TypeScope [ScopedFunction c]
fs,
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"}",
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"bool " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::CanConvertFrom(const S<const TypeInstance>& from) const {",
        AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
createCanConvertFrom AnyCategory c
t,
        String -> CompiledData [String]
onlyCode String
"}"
      ] where
      className :: String
className = CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
      params :: [ParamName]
params = (ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
  defineValueOverrides :: AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineValueOverrides AnyCategory c
t [ScopedFunction c]
fs = CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"std::string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::CategoryName() const { return parent->CategoryName(); }",
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::Dispatch(const ValueFunction& label, const ParamsArgs& params_args) {",
      AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
forall c.
AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch AnyCategory c
t SymbolScope
ValueScope [ScopedFunction c]
fs,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"}"
    ] where
      className :: String
className = CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)

  createMember :: r
-> Set ParamName
-> AnyCategory c
-> DefinedMember c
-> m (CompiledData [String])
createMember r
r Set ParamName
params AnyCategory c
t DefinedMember c
m = String
"In creation of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext (DefinedMember c -> [c]
forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) String -> m (CompiledData [String]) -> m (CompiledData [String])
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
    DefinedMember c
m' <- GeneralInstance -> DefinedMember c -> m (DefinedMember c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember (AnyCategory c -> GeneralInstance
forall c. AnyCategory c -> GeneralInstance
instanceFromCategory AnyCategory c
t) DefinedMember c
m
    r -> Set ParamName -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r Set ParamName
params (ValueType -> GeneralInstance
vtType (ValueType -> GeneralInstance) -> ValueType -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m')
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ ValueType -> String
variableStoredType (DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
  createMemberLazy :: r -> DefinedMember c -> m (CompiledData [String])
createMemberLazy r
r DefinedMember c
m = String
"In creation of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext (DefinedMember c -> [c]
forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) String -> m (CompiledData [String]) -> m (CompiledData [String])
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
    r -> Set ParamName -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r Set ParamName
forall a. Set a
Set.empty (ValueType -> GeneralInstance
vtType (ValueType -> GeneralInstance) -> ValueType -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m)
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ ValueType -> String
variableLazyType (DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"

  createParams :: [ValueParam c] -> CompiledData [String]
createParams = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat ([CompiledData [String]] -> CompiledData [String])
-> ([ValueParam c] -> [CompiledData [String]])
-> [ValueParam c]
-> CompiledData [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueParam c -> CompiledData [String])
-> [ValueParam c] -> [CompiledData [String]]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> CompiledData [String]
forall {c}. ValueParam c -> CompiledData [String]
createParam where
    createParam :: ValueParam c -> CompiledData [String]
createParam ValueParam c
p = String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
paramType String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName (ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam c
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"

  inlineCategoryConstructor :: AnyCategory c
-> DefinedCategory c
-> CategoryMap c
-> ExprMap c
-> m (CompiledData [String])
inlineCategoryConstructor AnyCategory c
t DefinedCategory c
d CategoryMap c
tm ExprMap c
em = do
    ProcedureContext c
ctx <- Bool
-> CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Bool
-> CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
getContextForInit Bool
testing CategoryMap c
tm ExprMap c
em AnyCategory c
t DefinedCategory c
d SymbolScope
CategoryScope
    CompiledData [String]
initMembers <- CompilerState (ProcedureContext c) m [()]
-> ProcedureContext c -> m (CompiledData [String])
forall c (m :: * -> *) s a b.
CompilerContext c m s a =>
CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler ([StateT (ProcedureContext c) m ()]
-> CompilerState (ProcedureContext c) m [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT (ProcedureContext c) m ()]
 -> CompilerState (ProcedureContext c) m [()])
-> [StateT (ProcedureContext c) m ()]
-> CompilerState (ProcedureContext c) m [()]
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> StateT (ProcedureContext c) m ())
-> [DefinedMember c] -> [StateT (ProcedureContext c) m ()]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName -> DefinedMember c -> StateT (ProcedureContext c) m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
CategoryName -> DefinedMember c -> CompilerState a m ()
compileLazyInit (CategoryName
 -> DefinedMember c -> StateT (ProcedureContext c) m ())
-> CategoryName
-> DefinedMember c
-> StateT (ProcedureContext c) m ()
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) [DefinedMember c]
members) ProcedureContext c
ctx
    let initMembersStr :: String
initMembersStr = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> [String]
forall s. CompiledData s -> s
cdOutput CompiledData [String]
initMembers
    let initColon :: String
initColon = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
initMembersStr then String
"" else String
" : "
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
initColon String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
initMembersStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)),
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ CategoryName -> SymbolScope -> String
startInitTracing (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) SymbolScope
CategoryScope,
        String -> CompiledData [String]
onlyCode String
"}",
        CompiledData [String] -> CompiledData [String]
clearCompiled CompiledData [String]
initMembers -- Inherit required types.
      ] where
        members :: [DefinedMember c]
members = (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope)(SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember c] -> [DefinedMember c])
-> [DefinedMember c] -> [DefinedMember c]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d
  inlineTypeConstructor :: AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t = do
    let ps2 :: [ParamName]
ps2 = (ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    let argParent :: String
argParent = CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& p"
    let paramsPassed :: String
paramsPassed = String
"Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([ParamName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ParamName]
ps2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type params"
    let allArgs :: String
allArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
paramsPassed]
    let initParent :: String
initParent = String
"parent(p)"
    let initPassed :: [String]
initPassed = ((Int, ParamName) -> String) -> [(Int, ParamName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,ParamName
p) -> ParamName -> String
paramName ParamName
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(std::get<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">(params))") ([(Int, ParamName)] -> [String]) -> [(Int, ParamName)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [ParamName] -> [(Int, ParamName)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [ParamName]
ps2
    let allInit :: String
allInit = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
initParentString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
initPassed
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allArgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allInit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)),
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ CategoryName -> SymbolScope -> String
startInitTracing (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) SymbolScope
TypeScope,
        String -> CompiledData [String]
onlyCode String
"}"
      ]
  inlineTypeDestructor :: Bool -> AnyCategory c -> m (CompiledData [String])
inlineTypeDestructor Bool
abstract AnyCategory c
t = do
    let ps2 :: [String]
ps2 = (ValueParam c -> String) -> [ValueParam c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ParamName -> String
paramName (ParamName -> String)
-> (ValueParam c -> ParamName) -> ValueParam c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam) ([ValueParam c] -> [String]) -> [ValueParam c] -> [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    let params :: String
params = String
"Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ps2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
ps2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    let prefix :: String
prefix = if Bool
abstract then String
"virtual " else String
"inline "
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [
        String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"~" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() { " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
params String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"); }"
      ]

  inlineFlatCleanup :: DefinedCategory a -> m (CompiledData [String])
inlineFlatCleanup DefinedCategory a
d = do
    let pragmas :: [PragmaDefined a]
pragmas = (PragmaDefined a -> Bool) -> [PragmaDefined a] -> [PragmaDefined a]
forall a. (a -> Bool) -> [a] -> [a]
filter PragmaDefined a -> Bool
forall c. PragmaDefined c -> Bool
isFlatCleanup ([PragmaDefined a] -> [PragmaDefined a])
-> [PragmaDefined a] -> [PragmaDefined a]
forall a b. (a -> b) -> a -> b
$ DefinedCategory a -> [PragmaDefined a]
forall c. DefinedCategory c -> [PragmaDefined c]
dcPragmas DefinedCategory a
d
    [PragmaDefined a] -> m (CompiledData [String])
forall {m :: * -> *} {a}.
(Show a, CollectErrorsM m) =>
[PragmaDefined a] -> m (CompiledData [String])
handle [PragmaDefined a]
pragmas where
      handle :: [PragmaDefined a] -> m (CompiledData [String])
handle [] = CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
emptyCode
      handle [FlatCleanup [a]
c VariableName
v] = do
        let ms :: [DefinedMember a]
ms = (DefinedMember a -> Bool) -> [DefinedMember a] -> [DefinedMember a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((VariableName -> VariableName -> Bool
forall a. Eq a => a -> a -> Bool
== VariableName
v) (VariableName -> Bool)
-> (DefinedMember a -> VariableName) -> DefinedMember a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember a -> VariableName
forall c. DefinedMember c -> VariableName
dmName) [DefinedMember a]
members
        case [DefinedMember a]
ms of
             [DefinedMember a
m] -> CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"BoxedValue FlatCleanup() final { return std::move(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (DefinedMember a -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember a
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"); }"
             [DefinedMember a]
_ -> String -> m (CompiledData [String])
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (CompiledData [String]))
-> String -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String
"FlatCleanup requires a non-weak boxed member" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
      handle [PragmaDefined a]
ps = String
"Only one FlatCleanup is allowed" String -> m (CompiledData [String]) -> m (CompiledData [String])
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
!!>
        ([String] -> m (CompiledData [String])
forall (m :: * -> *) a. CollectErrorsM m => [String] -> m a
mapErrorsM ([String] -> m (CompiledData [String]))
-> [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (PragmaDefined a -> String) -> [PragmaDefined a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\PragmaDefined a
p -> String
"FlatCleanup using " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (PragmaDefined a -> VariableName
forall c. PragmaDefined c -> VariableName
fcMember PragmaDefined a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (PragmaDefined a -> [a]
forall c. PragmaDefined c -> [c]
fcContext PragmaDefined a
p)) [PragmaDefined a]
ps)
      members :: [DefinedMember a]
members = (DefinedMember a -> Bool) -> [DefinedMember a] -> [DefinedMember a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((StorageType -> StorageType -> Bool
forall a. Eq a => a -> a -> Bool
/= StorageType
WeakValue) (StorageType -> Bool)
-> (DefinedMember a -> StorageType) -> DefinedMember a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueType -> StorageType
vtRequired (ValueType -> StorageType)
-> (DefinedMember a -> ValueType) -> DefinedMember a -> StorageType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember a -> ValueType
forall c. DefinedMember c -> ValueType
dmType) ([DefinedMember a] -> [DefinedMember a])
-> [DefinedMember a] -> [DefinedMember a]
forall a b. (a -> b) -> a -> b
$
                (DefinedMember a -> Bool) -> [DefinedMember a] -> [DefinedMember a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (DefinedMember a -> Bool) -> DefinedMember a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueType -> Bool
isStoredUnboxed (ValueType -> Bool)
-> (DefinedMember a -> ValueType) -> DefinedMember a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember a -> ValueType
forall c. DefinedMember c -> ValueType
dmType) ([DefinedMember a] -> [DefinedMember a])
-> [DefinedMember a] -> [DefinedMember a]
forall a b. (a -> b) -> a -> b
$
                (DefinedMember a -> Bool) -> [DefinedMember a] -> [DefinedMember a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) (SymbolScope -> Bool)
-> (DefinedMember a -> SymbolScope) -> DefinedMember a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember a -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember a] -> [DefinedMember a])
-> [DefinedMember a] -> [DefinedMember a]
forall a b. (a -> b) -> a -> b
$ DefinedCategory a -> [DefinedMember a]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory a
d

  inlineValueConstructor :: AnyCategory c -> DefinedCategory c -> m (CompiledData [String])
inlineValueConstructor AnyCategory c
t DefinedCategory c
d = do
    let argParent :: String
argParent = String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> p"
    let argsPassed :: String
argsPassed = String
"const ParamsArgs& params_args"
    let allArgs :: String
allArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
argsPassed]
    let initParent :: String
initParent = String
"parent(std::move(p))"
    let initArgs :: [String]
initArgs = ((Int, DefinedMember c) -> String)
-> [(Int, DefinedMember c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,DefinedMember c
m) -> VariableName -> String
variableName (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> DefinedMember c -> String
forall {a} {c}. Show a => a -> DefinedMember c -> String
unwrappedArg Int
i DefinedMember c
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") ([(Int, DefinedMember c)] -> [String])
-> [(Int, DefinedMember c)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [DefinedMember c] -> [(Int, DefinedMember c)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [DefinedMember c]
members
    let allInit :: String
allInit = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
initParentString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
initArgs
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allArgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allInit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {}" where
      unwrappedArg :: a -> DefinedMember c -> String
unwrappedArg a
i DefinedMember c
m = ValueType -> ExpressionValue -> String
writeStoredVariable (DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) (String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"params_args.GetArg(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
      members :: [DefinedMember c]
members = (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) (SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember c] -> [DefinedMember c])
-> [DefinedMember c] -> [DefinedMember c]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d

  abstractValueConstructor :: AnyCategory c -> m (CompiledData [String])
abstractValueConstructor AnyCategory c
t = do
    let argParent :: String
argParent = String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> p"
    let allArgs :: String
allArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent]
    let initParent :: String
initParent = String
"parent(std::move(p))"
    let allInit :: String
allInit = String
initParent
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allArgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allInit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {}"

  customTypeConstructor :: AnyCategory c -> m (CompiledData [String])
customTypeConstructor AnyCategory c
t = do
    let ps2 :: [ParamName]
ps2 = (ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    let argParent :: String
argParent = CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& p"
    let paramsPassed :: String
paramsPassed = String
"Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([ParamName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ParamName]
ps2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type params"
    let allArgs :: String
allArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
paramsPassed]
    let allInit :: String
allInit = CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(p, params)"
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCustom (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allArgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allInit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {}"

  customValueConstructor :: AnyCategory c -> m (CompiledData [String])
customValueConstructor AnyCategory c
t = do
    let argParent :: String
argParent = String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> p"
    let argsPassed :: String
argsPassed = String
"const ParamsArgs& params_args"
    let allArgs :: String
allArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
argsPassed]
    let allInit :: String
allInit = CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(std::move(p))"
    CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCustom (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allArgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allInit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {}"

  inlineTypeParamSelf :: AnyCategory c -> m (CompiledData [String])
inlineTypeParamSelf AnyCategory c
t = CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [
      String
"inline S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> Param_self() const {",
      String
"  return shared_from_this();",
      String
"}"
    ]

  inlineValueParamSelf :: AnyCategory c -> m (CompiledData [String])
inlineValueParamSelf AnyCategory c
t = CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [
      String
"inline S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> Param_self() const {",
      String
"  return parent;",
      String
"}"
    ]

  allowTestsOnly :: [String] -> [String]
allowTestsOnly
    | Bool
testing   = ([String]
testsOnlySourceGuard [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
    | Bool
otherwise = ([String]
noTestsOnlySourceGuard [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
  addSourceIncludes :: [String] -> [String]
addSourceIncludes = ([String]
baseSourceIncludes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
  addTemplateIncludes :: [String] -> [String]
addTemplateIncludes = ([String]
templateIncludes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
  addCategoryHeader :: AnyCategory c -> [String] -> [String]
addCategoryHeader AnyCategory c
t = ([String
"#include \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
headerFilename (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
  addStreamlinedHeader :: AnyCategory c -> [String] -> [String]
addStreamlinedHeader AnyCategory c
t = ([String
"#include \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
headerStreamlined (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
  addIncludes :: Set CategoryName -> [String] -> [String]
addIncludes Set CategoryName
req = ((CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\CategoryName
i -> String
"#include \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
headerFilename CategoryName
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"") (Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList Set CategoryName
req) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)
  headerGuard :: p -> [String] -> [String]
headerGuard p
t [String]
out = [String]
guardTop [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
out [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
guardBottom where
    guardTop :: [String]
guardTop = [String
"#ifndef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName,String
"#define " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardBottom :: [String]
guardBottom = [String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardName :: String
guardName = String
"STREAMLINED_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
t
  disallowTypeMembers :: (Ord c, Show c, CollectErrorsM m) => [DefinedMember c] -> m ()
  disallowTypeMembers :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
[DefinedMember c] -> m ()
disallowTypeMembers [DefinedMember c]
tm =
    [m Any] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ ([m Any] -> m ()) -> [m Any] -> m ()
forall a b. (a -> b) -> a -> b
$ ((DefinedMember c -> m Any) -> [DefinedMember c] -> [m Any])
-> [DefinedMember c] -> (DefinedMember c -> m Any) -> [m Any]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DefinedMember c -> m Any) -> [DefinedMember c] -> [m Any]
forall a b. (a -> b) -> [a] -> [b]
map [DefinedMember c]
tm
      (\DefinedMember c
m -> String -> m Any
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m Any) -> String -> m Any
forall a b. (a -> b) -> a -> b
$ String
"Member " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                              String
" is not allowed to be @type-scoped" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                              [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (DefinedMember c -> [c]
forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m))
  getCycleCheck :: String -> [String]
getCycleCheck String
n2 = [
      String
"CycleCheck<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Check();",
      String
"CycleCheck<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> marker(*this);"
    ]

  defineProcedure :: AnyCategory c
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
defineProcedure AnyCategory c
t = Bool
-> Bool
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool
-> Bool
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
compileExecutableProcedure Bool
testing (AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isImmutable AnyCategory c
t)
  declareProcedure :: AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t = Bool -> Bool -> ScopedFunction c -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
Bool -> Bool -> ScopedFunction c -> m (CompiledData [String])
procedureDeclaration (AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isImmutable AnyCategory c
t)

isImmutable :: AnyCategory c -> Bool
isImmutable :: forall c. AnyCategory c -> Bool
isImmutable = (PragmaCategory c -> Bool) -> [PragmaCategory c] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PragmaCategory c -> Bool
forall c. PragmaCategory c -> Bool
isCategoryImmutable ([PragmaCategory c] -> Bool)
-> (AnyCategory c -> [PragmaCategory c]) -> AnyCategory c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCategory c -> [PragmaCategory c]
forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas

formatFunctionTypes :: Show c => ScopedFunction c -> [String]
formatFunctionTypes :: forall c. Show c => ScopedFunction c -> [String]
formatFunctionTypes (ScopedFunction [c]
c FunctionName
_ CategoryName
_ SymbolScope
s FunctionVisibility c
_ Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fa [ScopedFunction c]
_) = [String
location,String
args,String
returns,String
params] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
filters where
  location :: String
location = SymbolScope -> String
forall a. Show a => a -> String
show SymbolScope
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" function declared at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  args :: String
args    = String
"Arg Types:    (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((PassedValue c, Maybe (CallArgLabel c)) -> String)
-> [(PassedValue c, Maybe (CallArgLabel c))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PassedValue c, Maybe (CallArgLabel c)) -> String
forall {c} {c}. (PassedValue c, Maybe (CallArgLabel c)) -> String
singleArg ([(PassedValue c, Maybe (CallArgLabel c))] -> [String])
-> [(PassedValue c, Maybe (CallArgLabel c))] -> [String]
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a. Positional a -> [a]
pValues Positional (PassedValue c, Maybe (CallArgLabel c))
as)  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  returns :: String
returns = String
"Return Types: (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((PassedValue c -> String) -> [PassedValue c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ValueType -> String
forall a. Show a => a -> String
show (ValueType -> String)
-> (PassedValue c -> ValueType) -> PassedValue c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType) ([PassedValue c] -> [String]) -> [PassedValue c] -> [String]
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues Positional (PassedValue c)
rs)  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  params :: String
params  = String
"Type Params:  <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((ValueParam c -> String) -> [ValueParam c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ParamName -> String
forall a. Show a => a -> String
show (ParamName -> String)
-> (ValueParam c -> ParamName) -> ValueParam c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam) ([ValueParam c] -> [String]) -> [ValueParam c] -> [String]
forall a b. (a -> b) -> a -> b
$ Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues Positional (ValueParam c)
ps) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  filters :: [String]
filters = (ParamFilter c -> String) -> [ParamFilter c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ParamFilter c -> String
forall {c}. ParamFilter c -> String
singleFilter [ParamFilter c]
fa
  singleFilter :: ParamFilter c -> String
singleFilter (ParamFilter [c]
_ ParamName
n2 TypeFilter
f) = String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeFilter -> String
forall a. Show a => a -> String
show TypeFilter
f
  singleArg :: (PassedValue c, Maybe (CallArgLabel c)) -> String
singleArg (PassedValue c
a,Just CallArgLabel c
n) = ValueType -> String
forall a. Show a => a -> String
show (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType PassedValue c
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CallArgLabel c -> String
forall c. CallArgLabel c -> String
calName CallArgLabel c
n)
  singleArg (PassedValue c
a,Maybe (CallArgLabel c)
_)      = ValueType -> String
forall a. Show a => a -> String
show (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType PassedValue c
a)

createMainCommon :: String -> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon :: String
-> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon String
n (CompiledData Set CategoryName
req0 Set String
_ [String]
out0) (CompiledData Set CategoryName
req1 Set String
_ [String]
out1) =
  [String]
baseSourceIncludes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
mainSourceIncludes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Set CategoryName -> [String]
depIncludes (Set CategoryName
req0 Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CategoryName
req1) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
out0 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"int main(int argc, const char** argv) {",
      String
"  SetSignalHandler();",
      String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
startMainTracing String
n
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
out1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"] where
      depIncludes :: Set CategoryName -> [String]
depIncludes Set CategoryName
req2 = (CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\CategoryName
i -> String
"#include \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
headerFilename CategoryName
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"") ([CategoryName] -> [String]) -> [CategoryName] -> [String]
forall a b. (a -> b) -> a -> b
$
                           Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList Set CategoryName
req2

generateMainFile :: (Ord c, Show c, CollectErrorsM m) =>
  CategoryMap c -> ExprMap c -> CategoryName -> FunctionName -> m (Namespace,[String])
generateMainFile :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c
-> CategoryName
-> FunctionName
-> m (Namespace, [String])
generateMainFile CategoryMap c
tm ExprMap c
em CategoryName
n FunctionName
f = String
"In the creation of the main binary procedure" String -> m (Namespace, [String]) -> m (Namespace, [String])
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  CompiledData [String]
ca <- CategoryMap c
-> ExprMap c -> Expression c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c -> Expression c -> m (CompiledData [String])
compileMainProcedure CategoryMap c
tm ExprMap c
em Expression c
forall {c}. Expression c
expr
  let file :: [String]
file = [String]
noTestsOnlySourceGuard [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
-> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon String
"main" CompiledData [String]
emptyCode (CompiledData [String]
argv CompiledData [String]
-> CompiledData [String] -> CompiledData [String]
forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
ca)
  ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
tm ([],CategoryName
n)
  (Namespace, [String]) -> m (Namespace, [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t,[String]
file) where
    funcCall :: FunctionCall c
funcCall = [c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [] FunctionName
f ([InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional []) ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [])
    mainType :: TypeInstanceOrParam
mainType = TypeInstance -> TypeInstanceOrParam
JustTypeInstance (TypeInstance -> TypeInstanceOrParam)
-> TypeInstance -> TypeInstanceOrParam
forall a b. (a -> b) -> a -> b
$ CategoryName -> InstanceParams -> TypeInstance
TypeInstance CategoryName
n ([GeneralInstance] -> InstanceParams
forall a. [a] -> Positional a
Positional [])
    expr :: Expression c
expr = [c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [] ([c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
forall c.
[c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
TypeCall [] TypeInstanceOrParam
mainType FunctionCall c
forall {c}. FunctionCall c
funcCall) []
    argv :: CompiledData [String]
argv = String -> CompiledData [String]
onlyCode String
"ProgramArgv program_argv(argc, argv);"

generateTestFile :: (Ord c, Show c, CollectErrorsM m) =>
  CategoryMap c -> ExprMap c  -> [String] -> Maybe ([c],TypeInstance) -> [TestProcedure c] ->
  m (CompiledData [String])
generateTestFile :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c
-> [String]
-> Maybe ([c], TypeInstance)
-> [TestProcedure c]
-> m (CompiledData [String])
generateTestFile CategoryMap c
tm ExprMap c
em [String]
args Maybe ([c], TypeInstance)
t [TestProcedure c]
ts = String
"In the creation of the test binary procedure" String -> m (CompiledData [String]) -> m (CompiledData [String])
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  CompiledData [String]
wrap <- case Maybe ([c], TypeInstance)
t of
               Just ([c], TypeInstance)
t2 -> CategoryMap c -> ([c], TypeInstance) -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], TypeInstance) -> m (CompiledData [String])
compileWrapTestcase CategoryMap c
tm ([c], TypeInstance)
t2
               Maybe ([c], TypeInstance)
Nothing -> CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
emptyCode
  CompiledData [String]
ts' <- ([CompiledData [String]] -> CompiledData [String])
-> m [CompiledData [String]] -> m (CompiledData [String])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat (m [CompiledData [String]] -> m (CompiledData [String]))
-> m [CompiledData [String]] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (TestProcedure c -> m (CompiledData [String]))
-> [TestProcedure c] -> m [CompiledData [String]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryMap c
-> ExprMap c -> TestProcedure c -> m (CompiledData [String])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c -> TestProcedure c -> m (CompiledData [String])
compileTestProcedure CategoryMap c
tm ExprMap c
em) [TestProcedure c]
ts
  ([String]
include,CompiledData [String]
sel) <- [FunctionName] -> m ([String], CompiledData [String])
forall (m :: * -> *).
CollectErrorsM m =>
[FunctionName] -> m ([String], CompiledData [String])
selectTestFromArgv1 ([FunctionName] -> m ([String], CompiledData [String]))
-> [FunctionName] -> m ([String], CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (TestProcedure c -> FunctionName)
-> [TestProcedure c] -> [FunctionName]
forall a b. (a -> b) -> [a] -> [b]
map TestProcedure c -> FunctionName
forall c. TestProcedure c -> FunctionName
tpName [TestProcedure c]
ts
  let (CompiledData Set CategoryName
req Set String
traces [String]
_) = CompiledData [String]
ts' CompiledData [String]
-> CompiledData [String] -> CompiledData [String]
forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
sel
  let contentTop :: CompiledData [String]
contentTop = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [CompiledData [String]
timeoutInclude,[String] -> CompiledData [String]
onlyCodes [String]
include,CompiledData [String]
ts']
  let contentMain :: CompiledData [String]
contentMain = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [CompiledData [String]
setTimeout,CompiledData [String]
argv,CompiledData [String]
callLog,CompiledData [String]
wrap,CompiledData [String]
sel]
  let file :: [String]
file = [String]
testsOnlySourceGuard [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
-> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon String
"testcase" CompiledData [String]
contentTop CompiledData [String]
contentMain
  CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> Set String -> [String] -> CompiledData [String]
forall s. Set CategoryName -> Set String -> s -> CompiledData s
CompiledData Set CategoryName
req Set String
traces [String]
file where
    args' :: [String]
args' = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
escapeChars [String]
args
    argv :: CompiledData [String]
argv = [String] -> CompiledData [String]
onlyCodes [
        String
"const char* argv2[] = { \"testcase\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
args') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" };",
        String
"ProgramArgv program_argv(sizeof argv2 / sizeof(char*), argv2);"
      ]
    callLog :: CompiledData [String]
callLog = String -> CompiledData [String]
onlyCode String
"LogCallsToFile call_logger_((argc < 3)? \"\" : argv[2]);"
    timeoutInclude :: CompiledData [String]
timeoutInclude = [String] -> CompiledData [String]
onlyCodes [
        String
"#ifdef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro,
        String
"#include <unistd.h>",
        String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro
      ]
    setTimeout :: CompiledData [String]
setTimeout = [String] -> CompiledData [String]
onlyCodes [
        String
"#ifdef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro,
        String
"alarm(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");",
        String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro
      ]

addNamespace :: AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace :: forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t CompiledData [String]
cs
  | Namespace -> Bool
isStaticNamespace (Namespace -> Bool) -> Namespace -> Bool
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Namespace -> String
forall a. Show a => a -> String
show (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      CompiledData [String]
cs,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"}  // namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Namespace -> String
forall a. Show a => a -> String
show (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t),
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"using namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Namespace -> String
forall a. Show a => a -> String
show (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    ]
  | Namespace -> Bool
isPublicNamespace (Namespace -> Bool) -> Namespace -> Bool
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#ifdef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      CompiledData [String]
cs,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#ifdef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"}  // namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"using namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro
    ]
  | Namespace -> Bool
isPrivateNamespace (Namespace -> Bool) -> Namespace -> Bool
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#ifdef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      CompiledData [String]
cs,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#ifdef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"}  // namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"using namespace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro
    ]
  | Bool
otherwise = CompiledData [String]
cs

createLabelForFunction :: Int -> ScopedFunction c -> String
createLabelForFunction :: forall c. Int -> ScopedFunction c -> String
createLabelForFunction Int
i ScopedFunction c
f = ScopedFunction c -> String
forall {c}. ScopedFunction c -> String
functionLabelType ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall {c}. ScopedFunction c -> String
functionName ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++
                              String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ScopedFunction c -> String
forall c. Int -> ScopedFunction c -> String
newFunctionLabel Int
i ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"

createFunctionDispatch :: AnyCategory c -> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch :: forall c.
AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch AnyCategory c
t SymbolScope
s [ScopedFunction c]
fs = CompiledData [String]
function where
  name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
  function :: CompiledData [String]
function
    | [ScopedFunction c] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScopedFunction c]
filtered = String -> CompiledData [String]
onlyCode String
fallback
    | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String
typedef] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
select
  filtered :: [ScopedFunction c]
filtered = (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
s) (SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
fs
  flatten :: ScopedFunction c -> [ScopedFunction c]
flatten ScopedFunction c
f = ScopedFunction c
fScopedFunction c -> [ScopedFunction c] -> [ScopedFunction c]
forall a. a -> [a] -> [a]
:([[ScopedFunction c]] -> [ScopedFunction c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ScopedFunction c]] -> [ScopedFunction c])
-> [[ScopedFunction c]] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> [ScopedFunction c])
-> [ScopedFunction c] -> [[ScopedFunction c]]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> [ScopedFunction c]
flatten ([ScopedFunction c] -> [[ScopedFunction c]])
-> [ScopedFunction c] -> [[ScopedFunction c]]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> [ScopedFunction c]
forall c. ScopedFunction c -> [ScopedFunction c]
sfMerges ScopedFunction c
f)
  flattened :: [ScopedFunction c]
flattened = [[ScopedFunction c]] -> [ScopedFunction c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ScopedFunction c]] -> [ScopedFunction c])
-> [[ScopedFunction c]] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> [ScopedFunction c])
-> [ScopedFunction c] -> [[ScopedFunction c]]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> [ScopedFunction c]
forall c. ScopedFunction c -> [ScopedFunction c]
flatten [ScopedFunction c]
filtered
  byCategory :: [(CategoryName, [FunctionName])]
byCategory = ((CategoryName, Set FunctionName)
 -> (CategoryName, [FunctionName]))
-> [(CategoryName, Set FunctionName)]
-> [(CategoryName, [FunctionName])]
forall a b. (a -> b) -> [a] -> [b]
map ((Set FunctionName -> [FunctionName])
-> (CategoryName, Set FunctionName)
-> (CategoryName, [FunctionName])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Set FunctionName -> [FunctionName]
forall a. Set a -> [a]
Set.toList) ([(CategoryName, Set FunctionName)]
 -> [(CategoryName, [FunctionName])])
-> [(CategoryName, Set FunctionName)]
-> [(CategoryName, [FunctionName])]
forall a b. (a -> b) -> a -> b
$ Map CategoryName (Set FunctionName)
-> [(CategoryName, Set FunctionName)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map CategoryName (Set FunctionName)
 -> [(CategoryName, Set FunctionName)])
-> Map CategoryName (Set FunctionName)
-> [(CategoryName, Set FunctionName)]
forall a b. (a -> b) -> a -> b
$ (Set FunctionName -> Set FunctionName -> Set FunctionName)
-> [(CategoryName, Set FunctionName)]
-> Map CategoryName (Set FunctionName)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set FunctionName -> Set FunctionName -> Set FunctionName
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([(CategoryName, Set FunctionName)]
 -> Map CategoryName (Set FunctionName))
-> [(CategoryName, Set FunctionName)]
-> Map CategoryName (Set FunctionName)
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> (CategoryName, Set FunctionName))
-> [ScopedFunction c] -> [(CategoryName, Set FunctionName)]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f,[FunctionName] -> Set FunctionName
forall a. Ord a => [a] -> Set a
Set.fromList [ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f])) [ScopedFunction c]
flattened
  typedef :: String
typedef
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"  using CallType = ReturnTuple(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const ParamsArgs&);"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"  using CallType = ReturnTuple(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const ParamsArgs&) const;"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"  using CallType = ReturnTuple(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const ParamsArgs&)" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined
  suffix :: String
suffix
    | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isImmutable AnyCategory c
t = String
" const"
    | Bool
otherwise     = String
""
  funcName :: FunctionName -> String
funcName FunctionName
f
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = CategoryName -> String
categoryName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = CategoryName -> String
typeName CategoryName
name     String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = CategoryName -> String
valueName CategoryName
name    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined
  select :: [String]
select = [
      String
"  switch (label.collection) {"
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
categoryCases [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"    default:",
      String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fallback,
      String
"  }"
    ]
  categoryCases :: [String]
categoryCases = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ((CategoryName, [FunctionName]) -> [String])
-> [(CategoryName, [FunctionName])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName, [FunctionName]) -> [String]
singleCase [(CategoryName, [FunctionName])]
byCategory
  singleCase :: (CategoryName, [FunctionName]) -> [String]
singleCase (CategoryName
n2,[FunctionName
f]) = [
      String
"    case " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":",
      String
"      // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" only has one " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolScope -> String
forall a. Show a => a -> String
show SymbolScope
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" function.",
      String
"      return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");"
    ]
  singleCase (CategoryName
n2,[FunctionName]
fs2) = [
      String
"    case " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":",
      String
"      static const CallType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
tableName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[] = {"
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (FunctionName -> String) -> [FunctionName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\FunctionName
f -> String
"        &" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
funcName FunctionName
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",") [FunctionName]
fs2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"      };",
      String
"      return (this->*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
tableName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[label.function_num])(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");"
    ]
  args :: String
args
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"params_args"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"params_args"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"params_args"
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined
  fallback :: String
fallback
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"  return TypeCategory::Dispatch(label, params_args);"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"  return TypeInstance::Dispatch(label, params_args);"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"  return TypeValue::Dispatch(label, params_args);"
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined

createCanConvertFrom :: AnyCategory c -> CompiledData [String]
createCanConvertFrom :: forall c. AnyCategory c -> CompiledData [String]
createCanConvertFrom AnyCategory c
t
  | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::CanConvertFrom(from);"
  | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
      String
"  std::vector<S<const TypeInstance>> args;",
      String
"  if (!from->TypeArgsForParent(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", args)) return false;",
      String
"  if(args.size() != " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(ParamName, Variance)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ParamName, Variance)]
params) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {",
      String
"    FAIL() << \"Wrong number of args (\" << args.size() << \")  for \" << CategoryName();",
      String
"  }"
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
checks [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"  return true;"] where
      params :: [(ParamName, Variance)]
params = (ValueParam c -> (ParamName, Variance))
-> [ValueParam c] -> [(ParamName, Variance)]
forall a b. (a -> b) -> [a] -> [b]
map (\ValueParam c
p -> (ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam c
p,ValueParam c -> Variance
forall c. ValueParam c -> Variance
vpVariance ValueParam c
p)) ([ValueParam c] -> [(ParamName, Variance)])
-> [ValueParam c] -> [(ParamName, Variance)]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
      checks :: [String]
checks = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Int, (ParamName, Variance)) -> [String])
-> [(Int, (ParamName, Variance))] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (ParamName, Variance)) -> [String]
forall {a}. Show a => (a, (ParamName, Variance)) -> [String]
singleCheck ([(Int, (ParamName, Variance))] -> [[String]])
-> [(Int, (ParamName, Variance))] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [(ParamName, Variance)] -> [(Int, (ParamName, Variance))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [(ParamName, Variance)]
params
      singleCheck :: (a, (ParamName, Variance)) -> [String]
singleCheck (a
i,(ParamName
p,Variance
Covariant))     = [a -> ParamName -> String
forall {a}. Show a => a -> ParamName -> String
checkCov a
i ParamName
p]
      singleCheck (a
i,(ParamName
p,Variance
Contravariant)) = [a -> ParamName -> String
forall {a}. Show a => a -> ParamName -> String
checkCon a
i ParamName
p]
      singleCheck (a
i,(ParamName
p,Variance
Invariant))     = [a -> ParamName -> String
forall {a}. Show a => a -> ParamName -> String
checkCov a
i ParamName
p,a -> ParamName -> String
forall {a}. Show a => a -> ParamName -> String
checkCon a
i ParamName
p]
      checkCov :: a -> ParamName -> String
checkCov a
i ParamName
p = String
"  if (!TypeInstance::CanConvert(args[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"], " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName ParamName
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")) return false;"
      checkCon :: a -> ParamName -> String
checkCon a
i ParamName
p = String
"  if (!TypeInstance::CanConvert(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName ParamName
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", args[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"])) return false;"

createTypeArgsForParent :: CollectErrorsM m => AnyCategory c -> m (CompiledData [String])
createTypeArgsForParent :: forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
createTypeArgsForParent AnyCategory c
t = do
  [String]
categoryCases <- ([[String]] -> [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[String]] -> m [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> a -> b
$ ((CategoryName, [GeneralInstance]) -> m [String])
-> [(CategoryName, [GeneralInstance])] -> m [[String]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryName, [GeneralInstance]) -> m [String]
forall {m :: * -> *}.
CollectErrorsM m =>
(CategoryName, [GeneralInstance]) -> m [String]
singleCase ((CategoryName, [GeneralInstance])
myType(CategoryName, [GeneralInstance])
-> [(CategoryName, [GeneralInstance])]
-> [(CategoryName, [GeneralInstance])]
forall a. a -> [a] -> [a]
:[(CategoryName, [GeneralInstance])]
refines)
  CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
      String
"  switch (category) {"
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
categoryCases [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"    default:",
      String
"      return false;",
      String
"  }"
    ] where
    params :: [(ParamName, Variance)]
params = (ValueParam c -> (ParamName, Variance))
-> [ValueParam c] -> [(ParamName, Variance)]
forall a b. (a -> b) -> [a] -> [b]
map (\ValueParam c
p -> (ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam c
p,ValueParam c -> Variance
forall c. ValueParam c -> Variance
vpVariance ValueParam c
p)) ([ValueParam c] -> [(ParamName, Variance)])
-> [ValueParam c] -> [(ParamName, Variance)]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    self :: TypeInstance
self = AnyCategory c -> TypeInstance
forall c. AnyCategory c -> TypeInstance
singleFromCategory AnyCategory c
t
    myType :: (CategoryName, [GeneralInstance])
myType = (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t,((ParamName, Variance) -> GeneralInstance)
-> [(ParamName, Variance)] -> [GeneralInstance]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> ((ParamName, Variance) -> TypeInstanceOrParam)
-> (ParamName, Variance)
-> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
True (ParamName -> TypeInstanceOrParam)
-> ((ParamName, Variance) -> ParamName)
-> (ParamName, Variance)
-> TypeInstanceOrParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamName, Variance) -> ParamName
forall a b. (a, b) -> a
fst) [(ParamName, Variance)]
params)
    refines :: [(CategoryName, [GeneralInstance])]
refines = (TypeInstance -> (CategoryName, [GeneralInstance]))
-> [TypeInstance] -> [(CategoryName, [GeneralInstance])]
forall a b. (a -> b) -> [a] -> [b]
map (\TypeInstance
r -> (TypeInstance -> CategoryName
tiName TypeInstance
r,InstanceParams -> [GeneralInstance]
forall a. Positional a -> [a]
pValues (InstanceParams -> [GeneralInstance])
-> InstanceParams -> [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ TypeInstance -> InstanceParams
tiParams TypeInstance
r)) ([TypeInstance] -> [(CategoryName, [GeneralInstance])])
-> [TypeInstance] -> [(CategoryName, [GeneralInstance])]
forall a b. (a -> b) -> a -> b
$ (ValueRefine c -> TypeInstance)
-> [ValueRefine c] -> [TypeInstance]
forall a b. (a -> b) -> [a] -> [b]
map ValueRefine c -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType ([ValueRefine c] -> [TypeInstance])
-> [ValueRefine c] -> [TypeInstance]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t
    singleCase :: (CategoryName, [GeneralInstance]) -> m [String]
singleCase (CategoryName
n2,[GeneralInstance]
ps) = do
      [GeneralInstance]
ps' <- (GeneralInstance -> m GeneralInstance)
-> [GeneralInstance] -> m [GeneralInstance]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (TypeInstance -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *).
CollectErrorsM m =>
TypeInstance -> GeneralInstance -> m GeneralInstance
reverseSelfInstance TypeInstance
self) [GeneralInstance]
ps
      [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [
          String
"    case " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":",
          String
"      args = std::vector<S<const TypeInstance>>{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((GeneralInstance -> String) -> [GeneralInstance] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> String
expandLocalType [GeneralInstance]
ps') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"};",
          String
"      return true;"
        ]

-- Similar to Procedure.expandGeneralInstance but doesn't account for scope.
expandLocalType :: GeneralInstance -> String
expandLocalType :: GeneralInstance -> String
expandLocalType GeneralInstance
t
  | GeneralInstance
t GeneralInstance -> GeneralInstance -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralInstance
forall a. Bounded a => a
minBound = String
allGetter String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()"
  | GeneralInstance
t GeneralInstance -> GeneralInstance -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralInstance
forall a. Bounded a => a
maxBound = String
anyGetter String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()"
expandLocalType GeneralInstance
t = ([String] -> String)
-> ([String] -> String)
-> (T GeneralInstance -> String)
-> GeneralInstance
-> String
forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [String] -> String
getAny [String] -> String
getAll T GeneralInstance -> String
TypeInstanceOrParam -> String
getSingle GeneralInstance
t where
  getAny :: [String] -> String
getAny [String]
ts = String
unionGetter     String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
combine [String]
ts
  getAll :: [String] -> String
getAll [String]
ts = String
intersectGetter String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
combine [String]
ts
  getSingle :: TypeInstanceOrParam -> String
getSingle (JustTypeInstance (TypeInstance CategoryName
t2 InstanceParams
ps)) =
    CategoryName -> String
typeGetter CategoryName
t2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([GeneralInstance] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GeneralInstance] -> Int) -> [GeneralInstance] -> Int
forall a b. (a -> b) -> a -> b
$ InstanceParams -> [GeneralInstance]
forall a. Positional a -> [a]
pValues InstanceParams
ps) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((GeneralInstance -> String) -> [GeneralInstance] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> String
expandLocalType ([GeneralInstance] -> [String]) -> [GeneralInstance] -> [String]
forall a b. (a -> b) -> a -> b
$ InstanceParams -> [GeneralInstance]
forall a. Positional a -> [a]
pValues InstanceParams
ps) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"
  getSingle (JustParamName Bool
_ ParamName
p)  = ParamName -> String
paramName ParamName
p
  getSingle (JustInferredType ParamName
p) = ParamName -> String
paramName ParamName
p
  combine :: [String] -> String
combine [String]
ps = String
"(L_get<S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">>(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
ps String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"

defineCategoryName :: SymbolScope -> CategoryName -> CompiledData [String]
defineCategoryName :: SymbolScope -> CategoryName -> CompiledData [String]
defineCategoryName SymbolScope
TypeScope     CategoryName
_ = String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"std::string CategoryName() const final { return parent.CategoryName(); }"
defineCategoryName SymbolScope
ValueScope    CategoryName
_ = String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"std::string CategoryName() const final { return parent->CategoryName(); }"
defineCategoryName SymbolScope
_             CategoryName
t = String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"std::string CategoryName() const final { return \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"; }"

defineTypeName :: [ParamName] -> CompiledData [String]
defineTypeName :: [ParamName] -> CompiledData [String]
defineTypeName [ParamName]
ps = String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  return TypeInstance::TypeNameFrom(output, parent" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((ParamName -> String) -> [ParamName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (ParamName -> String) -> ParamName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamName -> String
paramName) [ParamName]
ps) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");"

declareGetCategory :: AnyCategory c -> CompiledData [String]
declareGetCategory :: forall c. AnyCategory c -> CompiledData [String]
declareGetCategory AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes [String
categoryBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryGetter (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"();"]

defineGetCatetory :: AnyCategory c -> CompiledData [String]
defineGetCatetory :: forall c. AnyCategory c -> CompiledData [String]
defineGetCatetory AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes [
    String
categoryBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryGetter (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() {",
    String
"  return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"();",
    String
"}"
  ]

declareGetType :: AnyCategory c -> CompiledData [String]
declareGetType :: forall c. AnyCategory c -> CompiledData [String]
declareGetType AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes [
    String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeGetter (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++
            Int -> String
forall a. Show a => a -> String
show ([ValueParam c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type params);"
  ]

defineGetType :: AnyCategory c -> CompiledData [String]
defineGetType :: forall c. AnyCategory c -> CompiledData [String]
defineGetType AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes [
    String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeGetter (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++
            Int -> String
forall a. Show a => a -> String
show ([ValueParam c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type params) {",
    String
"  return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(params);",
    String
"}"
  ]

declareInternalCategory :: AnyCategory c -> CompiledData [String]
declareInternalCategory :: forall c. AnyCategory c -> CompiledData [String]
declareInternalCategory AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes [
    CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"();"
  ]

defineInternalCategory :: AnyCategory c -> CompiledData [String]
defineInternalCategory :: forall c. AnyCategory c -> CompiledData [String]
defineInternalCategory AnyCategory c
t = String -> AnyCategory c -> CompiledData [String]
forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalCategory2 (CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)) AnyCategory c
t

defineInternalCategory2 :: String -> AnyCategory c -> CompiledData [String]
defineInternalCategory2 :: forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalCategory2 String
className AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes [
    CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() {",
    String
"  static auto& category = *new " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"();",
    String
"  return category;",
    String
"}"
  ]

declareInternalType :: AnyCategory c -> Int -> CompiledData [String]
declareInternalType :: forall c. AnyCategory c -> Int -> CompiledData [String]
declareInternalType AnyCategory c
t Int
n = [String] -> CompiledData [String]
onlyCodes [
    String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
    String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"(const Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type& params);",
    String
"void " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"(const Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type& params);"
  ]

defineInternalType :: AnyCategory c -> Int -> CompiledData [String]
defineInternalType :: forall c. AnyCategory c -> Int -> CompiledData [String]
defineInternalType AnyCategory c
t = String -> AnyCategory c -> Int -> CompiledData [String]
forall c. String -> AnyCategory c -> Int -> CompiledData [String]
defineInternalType2 (CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)) AnyCategory c
t

defineInternalType2 :: String -> AnyCategory c -> Int -> CompiledData [String]
defineInternalType2 :: forall c. String -> AnyCategory c -> Int -> CompiledData [String]
defineInternalType2 String
className AnyCategory c
t Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 =
      [String] -> CompiledData [String]
onlyCodes [
        String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(const Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"  static const auto cached = S_get(new " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(), Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type()));",
        String
"  return cached;",
        String
"}",
        String
"void " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(const Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {}"
      ]
  | Bool
otherwise =
      [String] -> CompiledData [String]
onlyCodes [
        String
"static auto& " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cacheName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = *new InstanceCache<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">([](const Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"    return S_get(new " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(), params));",
        String
"  });",
        String
"S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(const Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"  return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cacheName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".GetOrCreate(params);",
        String
"}",
        String
"void " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(const Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cacheName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".Remove(params);",
        String
"}"
      ] where
        cacheName :: String
cacheName = CategoryName -> String
forall a. Show a => a -> String
show (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_instance_cache"

declareInternalValue :: AnyCategory c -> CompiledData [String]
declareInternalValue :: forall c. AnyCategory c -> CompiledData [String]
declareInternalValue AnyCategory c
t =
  [String] -> CompiledData [String]
onlyCodes [
      String
"BoxedValue " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"(S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> parent, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"const ParamsArgs& params_args);"
    ]

defineInternalValue :: AnyCategory c -> CompiledData [String]
defineInternalValue :: forall c. AnyCategory c -> CompiledData [String]
defineInternalValue AnyCategory c
t = String -> AnyCategory c -> CompiledData [String]
forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalValue2 (CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)) AnyCategory c
t

defineInternalValue2 :: String -> AnyCategory c -> CompiledData [String]
defineInternalValue2 :: forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalValue2 String
className AnyCategory c
t =
  [String] -> CompiledData [String]
onlyCodes [
      String
"BoxedValue " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCreator (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"(S<const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> parent, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"const ParamsArgs& params_args) {",
      String
"  return BoxedValue::New<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">(std::move(parent), params_args);",
      String
"}"
    ]

getCategoryMentions :: AnyCategory c -> Set.Set CategoryName
getCategoryMentions :: forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName] -> Set CategoryName)
-> [CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ [ValueRefine c] -> [CategoryName]
forall {c}. [ValueRefine c] -> [CategoryName]
fromRefines (AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t) [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++
                                       [ValueDefine c] -> [CategoryName]
forall {c}. [ValueDefine c] -> [CategoryName]
fromDefines (AnyCategory c -> [ValueDefine c]
forall c. AnyCategory c -> [ValueDefine c]
getCategoryDefines AnyCategory c
t) [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++
                                       [ScopedFunction c] -> [CategoryName]
forall {c}. [ScopedFunction c] -> [CategoryName]
fromFunctions (AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t) [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++
                                       [ParamFilter c] -> [CategoryName]
forall {c}. [ParamFilter c] -> [CategoryName]
fromFilters (AnyCategory c -> [ParamFilter c]
forall c. AnyCategory c -> [ParamFilter c]
getCategoryFilters AnyCategory c
t) where
  fromRefines :: [ValueRefine c] -> [CategoryName]
fromRefines [ValueRefine c]
rs = Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList (Set CategoryName -> [CategoryName])
-> Set CategoryName -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (ValueRefine c -> Set CategoryName)
-> [ValueRefine c] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInstance -> Set CategoryName
categoriesFromRefine (TypeInstance -> Set CategoryName)
-> (ValueRefine c -> TypeInstance)
-> ValueRefine c
-> Set CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueRefine c -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType) [ValueRefine c]
rs
  fromDefines :: [ValueDefine c] -> [CategoryName]
fromDefines [ValueDefine c]
ds = Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList (Set CategoryName -> [CategoryName])
-> Set CategoryName -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (ValueDefine c -> Set CategoryName)
-> [ValueDefine c] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (DefinesInstance -> Set CategoryName
categoriesFromDefine (DefinesInstance -> Set CategoryName)
-> (ValueDefine c -> DefinesInstance)
-> ValueDefine c
-> Set CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueDefine c -> DefinesInstance
forall c. ValueDefine c -> DefinesInstance
vdType) [ValueDefine c]
ds
  fromDefine :: DefinesInstance -> [CategoryName]
fromDefine (DefinesInstance CategoryName
d InstanceParams
ps) = CategoryName
dCategoryName -> [CategoryName] -> [CategoryName]
forall a. a -> [a] -> [a]
:([GeneralInstance] -> [CategoryName]
fromGenerals ([GeneralInstance] -> [CategoryName])
-> [GeneralInstance] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ InstanceParams -> [GeneralInstance]
forall a. Positional a -> [a]
pValues InstanceParams
ps)
  fromFunctions :: [ScopedFunction c] -> [CategoryName]
fromFunctions [ScopedFunction c]
fs = [[CategoryName]] -> [CategoryName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CategoryName]] -> [CategoryName])
-> [[CategoryName]] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> [CategoryName])
-> [ScopedFunction c] -> [[CategoryName]]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> [CategoryName]
forall {c}. ScopedFunction c -> [CategoryName]
fromFunction [ScopedFunction c]
fs
  fromFunction :: ScopedFunction c -> [CategoryName]
fromFunction (ScopedFunction [c]
_ FunctionName
_ CategoryName
t2 SymbolScope
_ FunctionVisibility c
_ Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
_ [ParamFilter c]
fs [ScopedFunction c]
_) =
    [CategoryName
t2] [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++ ([GeneralInstance] -> [CategoryName]
fromGenerals ([GeneralInstance] -> [CategoryName])
-> [GeneralInstance] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (PassedValue c -> GeneralInstance)
-> [PassedValue c] -> [GeneralInstance]
forall a b. (a -> b) -> [a] -> [b]
map (ValueType -> GeneralInstance
vtType (ValueType -> GeneralInstance)
-> (PassedValue c -> ValueType) -> PassedValue c -> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType) (((PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c)
-> [(PassedValue c, Maybe (CallArgLabel c))] -> [PassedValue c]
forall a b. (a -> b) -> [a] -> [b]
map (PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c
forall a b. (a, b) -> a
fst (Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a. Positional a -> [a]
pValues Positional (PassedValue c, Maybe (CallArgLabel c))
as) [PassedValue c] -> [PassedValue c] -> [PassedValue c]
forall a. [a] -> [a] -> [a]
++ Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues Positional (PassedValue c)
rs)) [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++ [ParamFilter c] -> [CategoryName]
forall {c}. [ParamFilter c] -> [CategoryName]
fromFilters [ParamFilter c]
fs
  fromFilters :: [ParamFilter c] -> [CategoryName]
fromFilters [ParamFilter c]
fs = [[CategoryName]] -> [CategoryName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CategoryName]] -> [CategoryName])
-> [[CategoryName]] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (ParamFilter c -> [CategoryName])
-> [ParamFilter c] -> [[CategoryName]]
forall a b. (a -> b) -> [a] -> [b]
map (TypeFilter -> [CategoryName]
fromFilter (TypeFilter -> [CategoryName])
-> (ParamFilter c -> TypeFilter) -> ParamFilter c -> [CategoryName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamFilter c -> TypeFilter
forall c. ParamFilter c -> TypeFilter
pfFilter) [ParamFilter c]
fs
  fromFilter :: TypeFilter -> [CategoryName]
fromFilter (TypeFilter FilterDirection
_ GeneralInstance
t2)  = Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList (Set CategoryName -> [CategoryName])
-> Set CategoryName -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> Set CategoryName
categoriesFromTypes GeneralInstance
t2
  fromFilter (DefinesFilter DefinesInstance
t2) = DefinesInstance -> [CategoryName]
fromDefine DefinesInstance
t2
  fromFilter TypeFilter
ImmutableFilter = []
  fromGenerals :: [GeneralInstance] -> [CategoryName]
fromGenerals = Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList (Set CategoryName -> [CategoryName])
-> ([GeneralInstance] -> Set CategoryName)
-> [GeneralInstance]
-> [CategoryName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> ([GeneralInstance] -> [Set CategoryName])
-> [GeneralInstance]
-> Set CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneralInstance -> Set CategoryName)
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes