{- -----------------------------------------------------------------------------
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CxxOutput] -> ShowS
$cshowList :: [CxxOutput] -> ShowS
show :: CxxOutput -> String
$cshow :: CxxOutput -> String
showsPrec :: Int -> CxxOutput -> ShowS
$cshowsPrec :: Int -> 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 <- 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 <- forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (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)
  forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
decforall 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 <- 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 <- forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (forall c. AnyCategory c -> CategoryDefinition c
NativeInterface AnyCategory c
t)
  forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
decforall 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 <- 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 <- forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (forall c.
CategoryName
-> CategoryMap c
-> Set Namespace
-> CategorySpec c
-> CategoryDefinition c
StreamlinedExtension (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) CategoryMap c
tm Set Namespace
ns CategorySpec c
spec)
  forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
decforall 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 =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing 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 =
  forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> CategoryDefinition c -> m [CxxOutput]
generateCategoryDefinition Bool
testing (forall c.
CategoryName
-> CategoryMap c -> CategorySpec c -> CategoryDefinition c
StreamlinedTemplate (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 =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                     (CategoryName -> String
headerFilename CategoryName
name)
                     (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                     (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                     (forall s. CompiledData s -> Set CategoryName
cdRequired CompiledData [String]
file)
                     (forall s. CompiledData s -> Set String
cdTraces CompiledData [String]
file)
                     (forall s. CompiledData s -> s
cdOutput CompiledData [String]
file) where
    file :: CompiledData [String]
file = forall a. Monoid a => [a] -> a
mconcat 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 forall a b. (a -> b) -> a -> b
$ (if Bool
testing then CategoryName -> [String]
testsOnlyCategoryGuard (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) else []),
        [String] -> CompiledData [String]
onlyCodes [String]
baseHeaderIncludes,
        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 = forall c. AnyCategory c -> Set CategoryName
getCategoryDeps AnyCategory c
t
    content :: CompiledData [String]
content = forall a. Monoid a => [a] -> a
mconcat [CompiledData [String]
categoryId,CompiledData [String]
labels,CompiledData [String]
getCategory2,CompiledData [String]
getType]
    name :: CategoryName
name = forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    guardTop :: [String]
guardTop = [String
"#ifndef " forall a. [a] -> [a] -> [a]
++ String
guardName,String
"#define " forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardBottom :: [String]
guardBottom = [String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardName :: String
guardName = String
"HEADER_" forall a. [a] -> [a] -> [a]
++ String
guardNamespace forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
name
    guardNamespace :: String
guardNamespace
      | Namespace -> Bool
isStaticNamespace forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = forall a. Show a => a -> String
show (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"_"
      | Bool
otherwise = String
""
    functions :: [ScopedFunction c]
functions = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {c} {c}. ScopedFunction c -> ScopedFunction c -> Ordering
compareName forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== CategoryName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> CategoryName
sfType) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
    compareName :: ScopedFunction c -> ScopedFunction c -> Ordering
compareName ScopedFunction c
x ScopedFunction c
y = forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
x forall a. Ord a => a -> a -> Ordering
`compare` forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
y
    categoryFunctions :: [ScopedFunction c]
categoryFunctions = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
functions
    typeFunctions :: [ScopedFunction c]
typeFunctions = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
functions
    valueFunctions :: [ScopedFunction c]
valueFunctions = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
functions
    labels :: CompiledData [String]
labels = [String] -> CompiledData [String]
onlyCodes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {c}. ScopedFunction c -> String
label forall a b. (a -> b) -> a -> b
$ [ScopedFunction c]
categoryFunctions forall a. [a] -> [a] -> [a]
++ [ScopedFunction c]
typeFunctions forall a. [a] -> [a] -> [a]
++ [ScopedFunction c]
valueFunctions
    label :: ScopedFunction c -> String
label ScopedFunction c
f = String
"extern " forall a. [a] -> [a] -> [a]
++ forall {c}. ScopedFunction c -> String
functionLabelType ScopedFunction c
f forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall {c}. ScopedFunction c -> String
functionName ScopedFunction c
f forall a. [a] -> [a] -> [a]
++ String
";"
    categoryId :: CompiledData [String]
categoryId = [String] -> CompiledData [String]
onlyCodes [
        String
"static constexpr CategoryId " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
name forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
actualId forall a. [a] -> [a] -> [a]
++ String
";"
      ]
    actualId :: Int
actualId = forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Int
hash forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
    getCategory2 :: CompiledData [String]
getCategory2
      | forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise             = forall c. AnyCategory c -> CompiledData [String]
declareGetCategory AnyCategory c
t
    getType :: CompiledData [String]
getType
      | forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise             = 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 = 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) m CxxOutput
singleSource where
    singleSource :: m CxxOutput
singleSource = do
      let filename :: String
filename = CategoryName -> String
sourceFilename (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
      let ([ScopedFunction c]
cf,[ScopedFunction c]
tf,[ScopedFunction c]
vf) = forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope forall c. ScopedFunction c -> SymbolScope
sfScope forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
      (CompiledData Set CategoryName
req Set String
traces [String]
out) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
          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,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareInternalGetters AnyCategory c
t,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInterfaceCategory AnyCategory c
t,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInterfaceType     AnyCategory c
t,
          forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineCategoryOverrides AnyCategory c
t [],
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineTypeOverrides     AnyCategory c
t [],
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInternalGetters AnyCategory c
t,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineExternalGetters AnyCategory c
t
        ]
      let req' :: Set CategoryName
req' = Set CategoryName
req forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                         String
filename
                         (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                         (forall a. Ord a => [a] -> Set a
Set.fromList [forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t])
                         Set CategoryName
req'
                         Set String
traces
                         ([String] -> [String]
allowTestsOnly forall a b. (a -> b) -> a -> b
$ [String] -> [String]
addSourceIncludes forall a b. (a -> b) -> a -> b
$ forall {c}. AnyCategory c -> [String] -> [String]
addCategoryHeader AnyCategory c
t 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' <- 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) <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
ta' ([],CategoryName
n)
    forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m CxxOutput
streamlinedHeader AnyCategory c
t,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 [forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineAbstractValue AnyCategory c
t]
        (CompiledData Set CategoryName
req Set String
traces [String]
out) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ [
            forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineAbstractCategory AnyCategory c
t,
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> Int -> CompiledData [String]
declareInternalType AnyCategory c
t (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t),
            forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineAbstractType AnyCategory c
t
          ] forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeValue forall a. [a] -> [a] -> [a]
++ [
            forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareAbstractGetters AnyCategory c
t
          ]
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CategoryName
n)
                           String
filename
                           (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                           (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                           Set CategoryName
req
                           Set String
traces
                           (forall {p}. Show p => p -> [String] -> [String]
headerGuard CategoryName
n forall a b. (a -> b) -> a -> b
$ [String] -> [String]
allowTestsOnly forall a b. (a -> b) -> a -> b
$ [String] -> [String]
addTemplateIncludes forall a b. (a -> b) -> a -> b
$ forall {c}. AnyCategory c -> [String] -> [String]
addCategoryHeader AnyCategory c
t 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) = forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope forall c. ScopedFunction c -> SymbolScope
sfScope forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
        let maybeValue :: [m (CompiledData [String])]
maybeValue = if CategoryName -> Bool
hasPrimitiveValue CategoryName
n
                            then []
                            else [forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineValueOverrides AnyCategory c
t (forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t)]
        (CompiledData Set CategoryName
req Set String
traces [String]
out) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ [
            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,
            forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineCategoryOverrides AnyCategory c
t (forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t),
            forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineTypeOverrides     AnyCategory c
t (forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t)
          ] forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeValue forall a. [a] -> [a] -> [a]
++ [
            forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineExternalGetters AnyCategory c
t
          ]
        let req' :: Set CategoryName
req' = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName
req,forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t]
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CategoryName
n)
                           String
filename
                           (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                           (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                           Set CategoryName
req'
                           Set String
traces
                           ([String] -> [String]
addSourceIncludes forall a b. (a -> b) -> a -> b
$ forall {c}. AnyCategory c -> [String] -> [String]
addStreamlinedHeader AnyCategory c
t 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)) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) m CxxOutput
streamlinedTemplate where
    streamlinedTemplate :: m CxxOutput
streamlinedTemplate = do
      CategoryMap c
tm' <- 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) <- 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] <- forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
getProcedureScopes CategoryMap c
tm' forall k a. Map k a
Map.empty (forall {c}. Show c => [ScopedFunction c] -> DefinedCategory c
defined forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t)
      let maybeGetter :: [m (CompiledData [String])]
maybeGetter = if CategoryName -> Bool
hasPrimitiveValue (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                           then []
                           else [forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareCustomValueGetter AnyCategory c
t]
      let maybeGetter2 :: [m (CompiledData [String])]
maybeGetter2 = if CategoryName -> Bool
hasPrimitiveValue (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                            then []
                            else [forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineCustomValueGetter AnyCategory c
t]
      let maybeValue :: [m (CompiledData [String])]
maybeValue = if CategoryName -> Bool
hasPrimitiveValue (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                          then []
                          else [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) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$
        [m (CompiledData [String])]
maybeGetter forall a. [a] -> [a] -> [a]
++ [
          forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomCategory AnyCategory c
t ProcedureScope c
cp,
          forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCustomType     AnyCategory c
t ProcedureScope c
tp
        ] forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeValue forall a. [a] -> [a] -> [a]
++ [
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineCustomGetters AnyCategory c
t
        ] forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
maybeGetter2
      let req' :: Set CategoryName
req' = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName
req,forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                         String
filename
                         (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                         (forall a. Ord a => [a] -> Set a
Set.fromList [forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t])
                         Set CategoryName
req'
                         Set String
traces
                         ([String] -> [String]
addTemplateIncludes forall a b. (a -> b) -> a -> b
$ forall {c}. AnyCategory c -> [String] -> [String]
addStreamlinedHeader AnyCategory c
t 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 = forall a b. (a -> b) -> [a] -> [b]
map 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 = forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,
        epArgs :: ArgValues c
epArgs = forall c. [c] -> Positional (InputValue c) -> ArgValues c
ArgValues [] forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Positional a
Positional forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {c}. Int -> InputValue c
createArg [Int
1..(forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues forall a b. (a -> b) -> a -> b
$ forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f)],
        epReturns :: ReturnValues c
epReturns = forall c. [c] -> ReturnValues c
UnnamedReturns [],
        epProcedure :: Procedure c
epProcedure = forall {c} {c}. Show c => ScopedFunction c -> Procedure c
failProcedure ScopedFunction c
f
      }
    createArg :: Int -> InputValue c
createArg = forall c. [c] -> VariableName -> InputValue c
InputValue [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VariableName
VariableName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"arg" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    failProcedure :: ScopedFunction c -> Procedure c
failProcedure ScopedFunction c
f = forall c. [c] -> [Statement c] -> Procedure c
Procedure [] forall a b. (a -> b) -> a -> b
$ [
        forall {c}. String -> Statement c
asLineComment forall a b. (a -> b) -> a -> b
$ String
"TODO: Implement " forall a. [a] -> [a] -> [a]
++ forall c. CategoryName -> ScopedFunction c -> String
functionDebugName CategoryName
n ScopedFunction c
f forall a. [a] -> [a] -> [a]
++ String
"."
      ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall {c}. String -> Statement c
asLineComment (forall c. Show c => ScopedFunction c -> [String]
formatFunctionTypes ScopedFunction c
f) forall a. [a] -> [a] -> [a]
++ [
        forall {c}. String -> Statement c
RawFailCall (forall c. CategoryName -> ScopedFunction c -> String
functionDebugName CategoryName
n ScopedFunction c
f forall a. [a] -> [a] -> [a]
++ String
" is not implemented (see " forall a. [a] -> [a] -> [a]
++ String
filename forall a. [a] -> [a] -> [a]
++ String
")")
      ]
    asLineComment :: String -> Statement c
asLineComment = forall c. [c] -> VoidExpression c -> Statement c
NoValueExpression [] forall b c a. (b -> c) -> (a -> b) -> a -> 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) m CxxOutput
singleSource where
    singleSource :: m CxxOutput
singleSource = do
      let filename :: String
filename = CategoryName -> String
sourceFilename (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
      CategoryMap c
ta' <- 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 = forall c. CategoryMap c -> CategoryResolver c
CategoryResolver CategoryMap c
ta'
      [ProcedureScope c
cp,ProcedureScope c
tp,ProcedureScope c
vp] <- 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]
_) = forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope forall c. DefinedMember c -> SymbolScope
dmScope [DefinedMember c]
ms
      forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
[DefinedMember c] -> m ()
disallowTypeMembers [DefinedMember c]
tm
      Set ParamName
params <- forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m (Set ParamName)
getCategoryParamSet AnyCategory c
t
      let cf :: [ScopedFunction c]
cf = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall c.
ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures ProcedureScope c
cp
      let tf :: [ScopedFunction c]
tf = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall c.
ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures ProcedureScope c
tp
      let vf :: [ScopedFunction c]
vf = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall c.
ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures ProcedureScope c
vp
      (CompiledData Set CategoryName
req Set String
traces [String]
out) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
          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,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
declareInternalGetters AnyCategory c
t,
          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,
          forall {m :: * -> *} {c} {c}.
CollectErrorsM m =>
[ScopedFunction c] -> AnyCategory c -> m (CompiledData [String])
defineConcreteType [ScopedFunction c]
tf AnyCategory c
t,
          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,
          forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineCategoryOverrides AnyCategory c
t [ScopedFunction c]
cf,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineTypeOverrides     AnyCategory c
t [ScopedFunction c]
tf,
          forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> [ScopedFunction c] -> m (CompiledData [String])
defineValueOverrides    AnyCategory c
t [ScopedFunction c]
vf,
          forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineCategoryFunctions AnyCategory c
t ProcedureScope c
cp,
          forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineTypeFunctions     AnyCategory c
t ProcedureScope c
tp,
          forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
AnyCategory c -> ProcedureScope c -> m (CompiledData [String])
defineValueFunctions    AnyCategory c
t ProcedureScope c
vp,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineInternalGetters AnyCategory c
t,
          forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
defineExternalGetters AnyCategory c
t
        ]
      let req' :: Set CategoryName
req' = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName
req,forall c. AnyCategory c -> Set CategoryName
getCategoryMentions AnyCategory c
t]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set String
-> [String]
-> CxxOutput
CxxOutput (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                         String
filename
                         (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                         (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                         Set CategoryName
req'
                         Set String
traces
                         ([String] -> [String]
allowTestsOnly forall a b. (a -> b) -> a -> b
$ [String] -> [String]
addSourceIncludes forall a b. (a -> b) -> a -> b
$ forall {c}. AnyCategory c -> [String] -> [String]
addCategoryHeader AnyCategory c
t 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 = forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    createAllLabels :: m (CompiledData [String])
createAllLabels = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {c}. [ScopedFunction c] -> [String]
createLabels [[ScopedFunction c]
cf,[ScopedFunction c]
tf,[ScopedFunction c]
vf]
    createLabels :: [ScopedFunction c] -> [String]
createLabels = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall c. Int -> ScopedFunction c -> String
createLabelForFunction) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {c} {c}. ScopedFunction c -> ScopedFunction c -> Ordering
compareName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== CategoryName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> CategoryName
sfType)
    compareName :: ScopedFunction c -> ScopedFunction c -> Ordering
compareName ScopedFunction c
x ScopedFunction c
y = forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
x forall a. Ord a => a -> a -> Ordering
`compare` forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
y

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

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

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

  defineInterfaceCategory :: AnyCategory c -> m (CompiledData [String])
defineInterfaceCategory AnyCategory c
t = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ String
categoryBase forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareCategoryOverrides,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]
  defineInterfaceType :: AnyCategory c -> m (CompiledData [String])
defineInterfaceType AnyCategory c
t = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ String
typeBase forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
Bool -> AnyCategory c -> m (CompiledData [String])
inlineTypeDestructor Bool
False AnyCategory c
t,
      forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareTypeOverrides,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {c}. [ValueParam c] -> CompiledData [String]
createParams forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"  " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"& parent;",
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ String
categoryBase forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ 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,
      forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareCategoryOverrides,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
False) [ScopedFunction c]
fs,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {m :: * -> *} {c} {r}.
(Show c, CollectErrorsM m, TypeResolver r) =>
r -> DefinedMember c -> m (CompiledData [String])
createMemberLazy r
r) [DefinedMember c]
members,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      members :: [DefinedMember c]
members = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope)forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> SymbolScope
dmScope) forall a b. (a -> b) -> a -> b
$ 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ String
typeBase forall a. [a] -> [a] -> [a]
++ String
", std::enable_shared_from_this<" forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"> {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
Bool -> AnyCategory c -> m (CompiledData [String])
inlineTypeDestructor Bool
False AnyCategory c
t,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeParamSelf AnyCategory c
t,
      forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareTypeOverrides,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
False) [ScopedFunction c]
fs,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {c}. [ValueParam c] -> CompiledData [String]
createParams forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"  " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"& parent;",
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      className :: String
className = CategoryName -> String
typeName (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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ String
valueBase forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c -> DefinedCategory c -> m (CompiledData [String])
inlineValueConstructor AnyCategory c
t DefinedCategory c
d,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineValueParamSelf AnyCategory c
t,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {a} {m :: * -> *}.
(Show a, CollectErrorsM m) =>
DefinedCategory a -> m (CompiledData [String])
inlineFlatCleanup DefinedCategory c
d,
      forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareValueOverrides,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
False) [ScopedFunction c]
fs,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"  const S<const " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> parent;",
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
traceCreation,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      members :: [DefinedMember c]
members = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope)forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> SymbolScope
dmScope) forall a b. (a -> b) -> a -> b
$ forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d
      procedures :: [ExecutableProcedure c]
procedures = forall c. DefinedCategory c -> [ExecutableProcedure c]
dcProcedures DefinedCategory c
d
      traceCreation :: [String]
traceCreation
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall c. PragmaProcedure c -> Bool
isTraceCreation forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. ExecutableProcedure c -> [PragmaProcedure c]
epPragmas [ExecutableProcedure c]
procedures = [CategoryName -> String
captureCreationTrace forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t]
        | Bool
otherwise = []

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

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

  defineAbstractValue :: AnyCategory c -> m (CompiledData [String])
defineAbstractValue AnyCategory c
t = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ String
valueBase forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
abstractValueConstructor AnyCategory c
t,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineValueParamSelf AnyCategory c
t,
      forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareValueOverrides,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {m :: * -> *} {c} {c}.
Monad m =>
AnyCategory c
-> Bool -> ScopedFunction c -> m (CompiledData [String])
declareProcedure AnyCategory c
t Bool
True) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope)forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> SymbolScope
sfScope) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t,
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"  virtual inline ~" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"() {}",
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"  const S<const " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> parent;",
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCustom (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (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,
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCustom (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
customTypeConstructor AnyCategory c
t,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (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,
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"struct " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCustom (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" : public " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" {",
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {c}.
Monad m =>
AnyCategory c -> m (CompiledData [String])
customValueConstructor AnyCategory c
t,
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall a b. (a -> b) -> a -> b
$ forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (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,
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (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 forall a b. (a -> b) -> a -> b
$ String -> CxxFunctionType
OutOfLineFunction forall a b. (a -> b) -> a -> b
$ CategoryName -> String
categoryName forall a b. (a -> b) -> a -> b
$ 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (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 forall a b. (a -> b) -> a -> b
$ String -> CxxFunctionType
OutOfLineFunction forall a b. (a -> b) -> a -> b
$ CategoryName -> String
typeName forall a b. (a -> b) -> a -> b
$ 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 = forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope (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 forall a b. (a -> b) -> a -> b
$ String -> CxxFunctionType
OutOfLineFunction forall a b. (a -> b) -> a -> b
$ CategoryName -> String
valueName forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"std::string " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::CategoryName() const { return \"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"\"; }",
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::Dispatch(const CategoryFunction& label, const ParamsArgs& params_args) {",
      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 (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 <- forall {m :: * -> *} {c}.
CollectErrorsM m =>
AnyCategory c -> m (CompiledData [String])
createTypeArgsForParent AnyCategory c
t
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"std::string " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::CategoryName() const { return parent.CategoryName(); }",
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"void " forall a. [a] -> [a] -> [a]
++ String
className 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 forall a b. (a -> b) -> a -> b
$ String
"bool " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::TypeArgsForParent(const CategoryId& category, std::vector<S<const TypeInstance>>& args) const {",
        CompiledData [String]
typeArgs,
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"}",
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::Dispatch(const TypeFunction& label, const ParamsArgs& params_args) const {",
        forall c.
AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch AnyCategory c
t SymbolScope
TypeScope [ScopedFunction c]
fs,
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"}",
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"bool " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::CanConvertFrom(const S<const TypeInstance>& from) const {",
        forall c. AnyCategory c -> CompiledData [String]
createCanConvertFrom AnyCategory c
t,
        String -> CompiledData [String]
onlyCode String
"}"
      ] where
      className :: String
className = CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
      params :: [ParamName]
params = forall a b. (a -> b) -> [a] -> [b]
map forall c. ValueParam c -> ParamName
vpParam forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"std::string " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::CategoryName() const { return parent->CategoryName(); }",
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"::Dispatch(const ValueFunction& label, const ParamsArgs& params_args) {",
      forall c.
AnyCategory c
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch AnyCategory c
t SymbolScope
ValueScope [ScopedFunction c]
fs,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"}"
    ] where
      className :: String
className = CategoryName -> String
valueName (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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) forall a. [a] -> [a] -> [a]
++ String
" at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContext (forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
    DefinedMember c
m' <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember (forall c. AnyCategory c -> GeneralInstance
instanceFromCategory AnyCategory c
t) DefinedMember c
m
    forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r Set ParamName
params (ValueType -> GeneralInstance
vtType forall a b. (a -> b) -> a -> b
$ forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m')
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ ValueType -> String
variableStoredType (forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m') forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m') forall a. [a] -> [a] -> [a]
++ String
";"
  createMemberLazy :: r -> DefinedMember c -> m (CompiledData [String])
createMemberLazy r
r DefinedMember c
m = String
"In creation of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) forall a. [a] -> [a] -> [a]
++ String
" at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContext (forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
    forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r forall a. Set a
Set.empty (ValueType -> GeneralInstance
vtType forall a b. (a -> b) -> a -> b
$ forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ ValueType -> String
variableLazyType (forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) forall a. [a] -> [a] -> [a]
++ String
";"

  createParams :: [ValueParam c] -> CompiledData [String]
createParams = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {c}. ValueParam c -> CompiledData [String]
createParam where
    createParam :: ValueParam c -> CompiledData [String]
createParam ValueParam c
p = String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
paramType forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName (forall c. ValueParam c -> ParamName
vpParam ValueParam c
p) 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 <- 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 <- forall c (m :: * -> *) s a b.
CompilerContext c m s a =>
CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
DefinedMember c -> CompilerState a m ()
compileLazyInit [DefinedMember c]
members) ProcedureContext c
ctx
    let initMembersStr :: String
initMembersStr = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ forall s. CompiledData s -> s
cdOutput CompiledData [String]
initMembers
    let initColon :: String
initColon = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
initMembersStr then String
"" else String
" : "
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"inline " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"()" forall a. [a] -> [a] -> [a]
++ String
initColon forall a. [a] -> [a] -> [a]
++ String
initMembersStr forall a. [a] -> [a] -> [a]
++ String
" {",
        CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)),
        CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ CategoryName -> SymbolScope -> String
startInitTracing (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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope)forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> SymbolScope
dmScope) forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> [a] -> [b]
map forall c. ValueParam c -> ParamName
vpParam forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    let argParent :: String
argParent = CategoryName -> String
categoryName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"& p"
    let paramsPassed :: String
paramsPassed = String
"Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ParamName]
ps2) forall a. [a] -> [a] -> [a]
++ String
">::Type params"
    let allArgs :: String
allArgs = forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
paramsPassed]
    let initParent :: String
initParent = String
"parent(p)"
    let initPassed :: [String]
initPassed = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,ParamName
p) -> ParamName -> String
paramName ParamName
p forall a. [a] -> [a] -> [a]
++ String
"(std::get<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
">(params))") forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [ParamName]
ps2
    let allInit :: String
allInit = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ String
initParentforall a. a -> [a] -> [a]
:[String]
initPassed
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"inline " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ String
allArgs forall a. [a] -> [a] -> [a]
++ String
") : " forall a. [a] -> [a] -> [a]
++ String
allInit forall a. [a] -> [a] -> [a]
++ String
" {",
        CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)),
        CompiledData [String] -> CompiledData [String]
indentCompiled forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ CategoryName -> SymbolScope -> String
startInitTracing (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 = forall a b. (a -> b) -> [a] -> [b]
map (ParamName -> String
paramName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ValueParam c -> ParamName
vpParam) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    let params :: String
params = String
"Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ps2) forall a. [a] -> [a] -> [a]
++ String
">::Type(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
ps2 forall a. [a] -> [a] -> [a]
++ String
")"
    let prefix :: String
prefix = if Bool
abstract then String
"virtual " else String
"inline "
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [
        String
prefix forall a. [a] -> [a] -> [a]
++ String
"~" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"() { " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ String
params forall a. [a] -> [a] -> [a]
++ String
"); }"
      ]

  inlineFlatCleanup :: DefinedCategory a -> m (CompiledData [String])
inlineFlatCleanup DefinedCategory a
d = do
    let pragmas :: [PragmaDefined a]
pragmas = forall a. (a -> Bool) -> [a] -> [a]
filter forall c. PragmaDefined c -> Bool
isFlatCleanup forall a b. (a -> b) -> a -> b
$ forall c. DefinedCategory c -> [PragmaDefined c]
dcPragmas DefinedCategory a
d
    forall {m :: * -> *} {a}.
(Show a, CollectErrorsM m) =>
[PragmaDefined a] -> m (CompiledData [String])
handle [PragmaDefined a]
pragmas where
      handle :: [PragmaDefined a] -> m (CompiledData [String])
handle [] = forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
emptyCode
      handle [FlatCleanup [a]
c VariableName
v] = do
        let ms :: [DefinedMember a]
ms = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== VariableName
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> VariableName
dmName) [DefinedMember a]
members
        case [DefinedMember a]
ms of
             [DefinedMember a
m] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"BoxedValue FlatCleanup() final { return std::move(" forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (forall c. DefinedMember c -> VariableName
dmName DefinedMember a
m) forall a. [a] -> [a] -> [a]
++ String
"); }"
             [DefinedMember a]
_ -> forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"FlatCleanup requires a non-weak boxed member" forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
      handle [PragmaDefined a]
ps = String
"Only one FlatCleanup is allowed" forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
!!>
        (forall (m :: * -> *) a. CollectErrorsM m => [String] -> m a
mapErrorsM forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\PragmaDefined a
p -> String
"FlatCleanup using " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. PragmaDefined c -> VariableName
fcMember PragmaDefined a
p) forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContextBrace (forall c. PragmaDefined c -> [c]
fcContext PragmaDefined a
p)) [PragmaDefined a]
ps)
      members :: [DefinedMember a]
members = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= StorageType
WeakValue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueType -> StorageType
vtRequired forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> ValueType
dmType) forall a b. (a -> b) -> a -> b
$
                forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueType -> Bool
isStoredUnboxed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> ValueType
dmType) forall a b. (a -> b) -> a -> b
$
                forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> SymbolScope
dmScope) forall a b. (a -> b) -> a -> b
$ 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 " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> p"
    let argsPassed :: String
argsPassed = String
"const ParamsArgs& params_args"
    let allArgs :: String
allArgs = forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
argsPassed]
    let initParent :: String
initParent = String
"parent(std::move(p))"
    let initArgs :: [String]
initArgs = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,DefinedMember c
m) -> VariableName -> String
variableName (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall {a} {c}. Show a => a -> DefinedMember c -> String
unwrappedArg Int
i DefinedMember c
m forall a. [a] -> [a] -> [a]
++ String
")") forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [DefinedMember c]
members
    let allInit :: String
allInit = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ String
initParentforall a. a -> [a] -> [a]
:[String]
initArgs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"inline " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ String
allArgs forall a. [a] -> [a] -> [a]
++ String
") : " forall a. [a] -> [a] -> [a]
++ String
allInit forall a. [a] -> [a] -> [a]
++ String
" {}" where
      unwrappedArg :: a -> DefinedMember c -> String
unwrappedArg a
i DefinedMember c
m = ValueType -> ExpressionValue -> String
writeStoredVariable (forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) (String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"params_args.GetArg(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
i forall a. [a] -> [a] -> [a]
++ String
")")
      members :: [DefinedMember c]
members = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> SymbolScope
dmScope) forall a b. (a -> b) -> a -> b
$ 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 " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> p"
    let allArgs :: String
allArgs = forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent]
    let initParent :: String
initParent = String
"parent(std::move(p))"
    let allInit :: String
allInit = String
initParent
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"inline " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ String
allArgs forall a. [a] -> [a] -> [a]
++ String
") : " forall a. [a] -> [a] -> [a]
++ String
allInit forall a. [a] -> [a] -> [a]
++ String
" {}"

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

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

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

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

isImmutable :: AnyCategory c -> Bool
isImmutable :: forall c. AnyCategory c -> Bool
isImmutable = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall c. PragmaCategory c -> Bool
isCategoryImmutable forall b c a. (b -> c) -> (a -> b) -> a -> 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] forall a. [a] -> [a] -> [a]
++ [String]
filters where
  location :: String
location = forall a. Show a => a -> String
show SymbolScope
s forall a. [a] -> [a] -> [a]
++ String
" function declared at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContext [c]
c
  args :: String
args    = String
"Arg Types:    (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall {c} {c}. (PassedValue c, Maybe (CallArgLabel c)) -> String
singleArg forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues Positional (PassedValue c, Maybe (CallArgLabel c))
as)  forall a. [a] -> [a] -> [a]
++ String
")"
  returns :: String
returns = String
"Return Types: (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. PassedValue c -> ValueType
pvType) forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues Positional (PassedValue c)
rs)  forall a. [a] -> [a] -> [a]
++ String
")"
  params :: String
params  = String
"Type Params:  <" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ValueParam c -> ParamName
vpParam) forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues Positional (ValueParam c)
ps) forall a. [a] -> [a] -> [a]
++ String
">"
  filters :: [String]
filters = forall a b. (a -> b) -> [a] -> [b]
map forall {c}. ParamFilter c -> String
singleFilter [ParamFilter c]
fa
  singleFilter :: ParamFilter c -> String
singleFilter (ParamFilter [c]
_ ParamName
n2 TypeFilter
f) = String
"  " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParamName
n2 forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeFilter
f
  singleArg :: (PassedValue c, Maybe (CallArgLabel c)) -> String
singleArg (PassedValue c
a,Just CallArgLabel c
n) = forall a. Show a => a -> String
show (forall c. PassedValue c -> ValueType
pvType PassedValue c
a) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ (forall c. CallArgLabel c -> String
calName CallArgLabel c
n)
  singleArg (PassedValue c
a,Maybe (CallArgLabel c)
_)      = forall a. Show a => a -> String
show (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 forall a. [a] -> [a] -> [a]
++ [String]
mainSourceIncludes forall a. [a] -> [a] -> [a]
++ Set CategoryName -> [String]
depIncludes (Set CategoryName
req0 forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CategoryName
req1) forall a. [a] -> [a] -> [a]
++ [String]
out0 forall a. [a] -> [a] -> [a]
++ [
      String
"int main(int argc, const char** argv) {",
      String
"  SetSignalHandler();",
      String
"  " forall a. [a] -> [a] -> [a]
++ ShowS
startMainTracing String
n
    ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String
"  " forall a. [a] -> [a] -> [a]
++) [String]
out1 forall a. [a] -> [a] -> [a]
++ [String
"}"] where
      depIncludes :: Set CategoryName -> [String]
depIncludes Set CategoryName
req2 = forall a b. (a -> b) -> [a] -> [b]
map (\CategoryName
i -> String
"#include \"" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
headerFilename CategoryName
i forall a. [a] -> [a] -> [a]
++ String
"\"") forall a b. (a -> b) -> a -> b
$
                           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" forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  CompiledData [String]
ca <- 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 forall {c}. Expression c
expr
  let file :: [String]
file = [String]
noTestsOnlySourceGuard forall a. [a] -> [a] -> [a]
++ String
-> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon String
"main" CompiledData [String]
emptyCode (CompiledData [String]
argv forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
ca)
  ([c]
_,AnyCategory c
t) <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
tm ([],CategoryName
n)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t,[String]
file) where
    funcCall :: FunctionCall c
funcCall = forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [] FunctionName
f (forall a. [a] -> Positional a
Positional []) (forall a. [a] -> Positional a
Positional [])
    mainType :: TypeInstanceOrParam
mainType = TypeInstance -> TypeInstanceOrParam
JustTypeInstance forall a b. (a -> b) -> a -> b
$ CategoryName -> InstanceParams -> TypeInstance
TypeInstance CategoryName
n (forall a. [a] -> Positional a
Positional [])
    expr :: Expression c
expr = forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [] (forall c.
[c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
TypeCall [] TypeInstanceOrParam
mainType 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" forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  CompiledData [String]
wrap <- case Maybe ([c], TypeInstance)
t of
               Just ([c], TypeInstance)
t2 -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
emptyCode
  CompiledData [String]
ts' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (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) <- forall (m :: * -> *).
CollectErrorsM m =>
[FunctionName] -> m ([String], CompiledData [String])
selectTestFromArgv1 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. TestProcedure c -> FunctionName
tpName [TestProcedure c]
ts
  let (CompiledData Set CategoryName
req Set String
traces [String]
_) = CompiledData [String]
ts' forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
sel
  let contentTop :: CompiledData [String]
contentTop = forall a. Monoid a => [a] -> a
mconcat [CompiledData [String]
timeoutInclude,[String] -> CompiledData [String]
onlyCodes [String]
include,CompiledData [String]
ts']
  let contentMain :: CompiledData [String]
contentMain = 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 forall a. [a] -> [a] -> [a]
++ String
-> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon String
"testcase" CompiledData [String]
contentTop CompiledData [String]
contentMain
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. Set CategoryName -> Set String -> s -> CompiledData s
CompiledData Set CategoryName
req Set String
traces [String]
file where
    args' :: [String]
args' = 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\" " forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (String
", " forall a. [a] -> [a] -> [a]
++) [String]
args') 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 " forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro,
        String
"#include <unistd.h>",
        String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro
      ]
    setTimeout :: CompiledData [String]
setTimeout = [String] -> CompiledData [String]
onlyCodes [
        String
"#ifdef " forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro,
        String
"alarm(" forall a. [a] -> [a] -> [a]
++ String
testTimeoutMacro forall a. [a] -> [a] -> [a]
++ String
");",
        String
"#endif  // " 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 forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"namespace " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
" {",
      CompiledData [String]
cs,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"}  // namespace " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t),
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"using namespace " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
";"
    ]
  | Namespace -> Bool
isPublicNamespace forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#ifdef " forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"namespace " forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro forall a. [a] -> [a] -> [a]
++ String
" {",
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      CompiledData [String]
cs,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#ifdef " forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"}  // namespace " forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"using namespace " forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro forall a. [a] -> [a] -> [a]
++ String
";",
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
publicNamespaceMacro
    ]
  | Namespace -> Bool
isPrivateNamespace forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#ifdef " forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"namespace " forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro forall a. [a] -> [a] -> [a]
++ String
" {",
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      CompiledData [String]
cs,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#ifdef " forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"}  // namespace " forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro,
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"using namespace " forall a. [a] -> [a] -> [a]
++ String
privateNamespaceMacro forall a. [a] -> [a] -> [a]
++ String
";",
      String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"#endif  // " 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 = forall {c}. ScopedFunction c -> String
functionLabelType ScopedFunction c
f forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall {c}. ScopedFunction c -> String
functionName ScopedFunction c
f forall a. [a] -> [a] -> [a]
++
                              String
" = " forall a. [a] -> [a] -> [a]
++ forall c. Int -> ScopedFunction c -> String
newFunctionLabel Int
i ScopedFunction c
f 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 = forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
  function :: CompiledData [String]
function
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScopedFunction c]
filtered = String -> CompiledData [String]
onlyCode String
fallback
    | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes forall a b. (a -> b) -> a -> b
$ [String
typedef] forall a. [a] -> [a] -> [a]
++ [String]
select
  filtered :: [ScopedFunction c]
filtered = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
fs
  flatten :: ScopedFunction c -> [ScopedFunction c]
flatten ScopedFunction c
f = ScopedFunction c
fforall a. a -> [a] -> [a]
:(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> [ScopedFunction c]
flatten forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> [ScopedFunction c]
sfMerges ScopedFunction c
f)
  flattened :: [ScopedFunction c]
flattened = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. ScopedFunction c -> [ScopedFunction c]
flatten [ScopedFunction c]
filtered
  byCategory :: [(CategoryName, [FunctionName])]
byCategory = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. Set a -> [a]
Set.toList) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f,forall a. Ord a => [a] -> Set a
Set.fromList [forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f])) [ScopedFunction c]
flattened
  typedef :: String
typedef
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"  using CallType = ReturnTuple(" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName CategoryName
name forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const ParamsArgs&);"
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"  using CallType = ReturnTuple(" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
name forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const ParamsArgs&) const;"
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"  using CallType = ReturnTuple(" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName CategoryName
name forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const ParamsArgs&)" forall a. [a] -> [a] -> [a]
++ String
suffix forall a. [a] -> [a] -> [a]
++ String
";"
    | Bool
otherwise = forall a. HasCallStack => a
undefined
  suffix :: String
suffix
    | forall c. AnyCategory c -> Bool
isImmutable AnyCategory c
t = String
" const"
    | Bool
otherwise     = String
""
  funcName :: FunctionName -> String
funcName FunctionName
f
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = CategoryName -> String
categoryName CategoryName
name forall a. [a] -> [a] -> [a]
++ String
"::" forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = CategoryName -> String
typeName CategoryName
name     forall a. [a] -> [a] -> [a]
++ String
"::" forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = CategoryName -> String
valueName CategoryName
name    forall a. [a] -> [a] -> [a]
++ String
"::" forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | Bool
otherwise = forall a. HasCallStack => a
undefined
  select :: [String]
select = [
      String
"  switch (label.collection) {"
    ] forall a. [a] -> [a] -> [a]
++ [String]
categoryCases forall a. [a] -> [a] -> [a]
++ [
      String
"    default:",
      String
"    " forall a. [a] -> [a] -> [a]
++ String
fallback,
      String
"  }"
    ]
  categoryCases :: [String]
categoryCases = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ 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 " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
n2 forall a. [a] -> [a] -> [a]
++ String
":",
      String
"      // " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n2 forall a. [a] -> [a] -> [a]
++ String
" only has one " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SymbolScope
s forall a. [a] -> [a] -> [a]
++ String
" function.",
      String
"      return " forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ String
args forall a. [a] -> [a] -> [a]
++ String
");"
    ]
  singleCase (CategoryName
n2,[FunctionName]
fs2) = [
      String
"    case " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
n2 forall a. [a] -> [a] -> [a]
++ String
":",
      String
"      static const CallType " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
tableName CategoryName
n2 forall a. [a] -> [a] -> [a]
++ String
"[] = {"
    ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\FunctionName
f -> String
"        &" forall a. [a] -> [a] -> [a]
++ FunctionName -> String
funcName FunctionName
f forall a. [a] -> [a] -> [a]
++ String
",") [FunctionName]
fs2 forall a. [a] -> [a] -> [a]
++ [
      String
"      };",
      String
"      return (this->*" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
tableName CategoryName
n2 forall a. [a] -> [a] -> [a]
++ String
"[label.function_num])(" forall a. [a] -> [a] -> [a]
++ String
args forall a. [a] -> [a] -> [a]
++ String
");"
    ]
  args :: String
args
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"params_args"
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"params_args"
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"params_args"
    | Bool
otherwise = forall a. HasCallStack => a
undefined
  fallback :: String
fallback
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"  return TypeCategory::Dispatch(label, params_args);"
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"  return TypeInstance::Dispatch(label, params_args);"
    | SymbolScope
s forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"  return TypeValue::Dispatch(label, params_args);"
    | Bool
otherwise = forall a. HasCallStack => a
undefined

createCanConvertFrom :: AnyCategory c -> CompiledData [String]
createCanConvertFrom :: forall c. AnyCategory c -> CompiledData [String]
createCanConvertFrom AnyCategory c
t
  | forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"  return " forall a. [a] -> [a] -> [a]
++ String
typeBase forall a. [a] -> [a] -> [a]
++ String
"::CanConvertFrom(from);"
  | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes forall a b. (a -> b) -> a -> b
$ [
      String
"  std::vector<S<const TypeInstance>> args;",
      String
"  if (!from->TypeArgsForParent(" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
", args)) return false;",
      String
"  if(args.size() != " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ParamName, Variance)]
params) forall a. [a] -> [a] -> [a]
++ String
") {",
      String
"    FAIL() << \"Wrong number of args (\" << args.size() << \")  for \" << CategoryName();",
      String
"  }"
    ] forall a. [a] -> [a] -> [a]
++ [String]
checks forall a. [a] -> [a] -> [a]
++ [String
"  return true;"] where
      params :: [(ParamName, Variance)]
params = forall a b. (a -> b) -> [a] -> [b]
map (\ValueParam c
p -> (forall c. ValueParam c -> ParamName
vpParam ValueParam c
p,forall c. ValueParam c -> Variance
vpVariance ValueParam c
p)) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
      checks :: [String]
checks = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, (ParamName, Variance)) -> [String]
singleCheck forall a b. (a -> b) -> a -> b
$ 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))     = [forall {a}. Show a => a -> ParamName -> String
checkCov a
i ParamName
p]
      singleCheck (a
i,(ParamName
p,Variance
Contravariant)) = [forall {a}. Show a => a -> ParamName -> String
checkCon a
i ParamName
p]
      singleCheck (a
i,(ParamName
p,Variance
Invariant))     = [forall {a}. Show a => a -> ParamName -> String
checkCov a
i ParamName
p,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[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
i forall a. [a] -> [a] -> [a]
++ String
"], " forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName ParamName
p forall a. [a] -> [a] -> [a]
++ String
")) return false;"
      checkCon :: a -> ParamName -> String
checkCon a
i ParamName
p = String
"  if (!TypeInstance::CanConvert(" forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName ParamName
p forall a. [a] -> [a] -> [a]
++ String
", args[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
i 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall {m :: * -> *}.
CollectErrorsM m =>
(CategoryName, [GeneralInstance]) -> m [String]
singleCase ((CategoryName, [GeneralInstance])
myTypeforall a. a -> [a] -> [a]
:[(CategoryName, [GeneralInstance])]
refines)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes forall a b. (a -> b) -> a -> b
$ [
      String
"  switch (category) {"
    ] forall a. [a] -> [a] -> [a]
++ [String]
categoryCases forall a. [a] -> [a] -> [a]
++ [
      String
"    default:",
      String
"      return false;",
      String
"  }"
    ] where
    params :: [(ParamName, Variance)]
params = forall a b. (a -> b) -> [a] -> [b]
map (\ValueParam c
p -> (forall c. ValueParam c -> ParamName
vpParam ValueParam c
p,forall c. ValueParam c -> Variance
vpVariance ValueParam c
p)) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    self :: TypeInstance
self = forall c. AnyCategory c -> TypeInstance
singleFromCategory AnyCategory c
t
    myType :: (CategoryName, [GeneralInstance])
myType = (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t,forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Eq a, Ord a) => a -> GeneralType a
singleType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ParamName, Variance)]
params)
    refines :: [(CategoryName, [GeneralInstance])]
refines = forall a b. (a -> b) -> [a] -> [b]
map (\TypeInstance
r -> (TypeInstance -> CategoryName
tiName TypeInstance
r,forall a. Positional a -> [a]
pValues forall a b. (a -> b) -> a -> b
$ TypeInstance -> InstanceParams
tiParams TypeInstance
r)) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. ValueRefine c -> TypeInstance
vrType forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t
    singleCase :: (CategoryName, [GeneralInstance]) -> m [String]
singleCase (CategoryName
n2,[GeneralInstance]
ps) = do
      [GeneralInstance]
ps' <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall (m :: * -> *).
CollectErrorsM m =>
TypeInstance -> GeneralInstance -> m GeneralInstance
reverseSelfInstance TypeInstance
self) [GeneralInstance]
ps
      forall (m :: * -> *) a. Monad m => a -> m a
return [
          String
"    case " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryIdName CategoryName
n2 forall a. [a] -> [a] -> [a]
++ String
":",
          String
"      args = std::vector<S<const TypeInstance>>{" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> String
expandLocalType [GeneralInstance]
ps') 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 forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound = String
allGetter forall a. [a] -> [a] -> [a]
++ String
"()"
  | GeneralInstance
t forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound = String
anyGetter forall a. [a] -> [a] -> [a]
++ String
"()"
expandLocalType GeneralInstance
t = forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [String] -> String
getAny [String] -> String
getAll TypeInstanceOrParam -> String
getSingle GeneralInstance
t where
  getAny :: [String] -> String
getAny [String]
ts = String
unionGetter     forall a. [a] -> [a] -> [a]
++ [String] -> String
combine [String]
ts
  getAll :: [String] -> String
getAll [String]
ts = String
intersectGetter 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 forall a. [a] -> [a] -> [a]
++ String
"(Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues InstanceParams
ps) forall a. [a] -> [a] -> [a]
++ String
">::Type(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> String
expandLocalType forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues InstanceParams
ps) 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 " forall a. [a] -> [a] -> [a]
++ String
typeBase forall a. [a] -> [a] -> [a]
++ String
">>(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
ps forall a. [a] -> [a] -> [a]
++ String
"))"

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

defineTypeName :: [ParamName] -> CompiledData [String]
defineTypeName :: [ParamName] -> CompiledData [String]
defineTypeName [ParamName]
ps = String -> CompiledData [String]
onlyCode forall a b. (a -> b) -> a -> b
$ String
"  return TypeInstance::TypeNameFrom(output, parent" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map ((String
", " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamName -> String
paramName) [ParamName]
ps) 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 forall a. [a] -> [a] -> [a]
++ String
"& " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryGetter (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) 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 forall a. [a] -> [a] -> [a]
++ String
"& " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryGetter (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"() {",
    String
"  return " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) 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 " forall a. [a] -> [a] -> [a]
++ String
typeBase forall a. [a] -> [a] -> [a]
++ String
"> " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeGetter (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(Params<" forall a. [a] -> [a] -> [a]
++
            forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t) 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 " forall a. [a] -> [a] -> [a]
++ String
typeBase forall a. [a] -> [a] -> [a]
++ String
"> " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeGetter (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(Params<" forall a. [a] -> [a] -> [a]
++
            forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
">::Type params) {",
    String
"  return " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) 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 (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"& " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"();"
  ]

defineInternalCategory :: AnyCategory c -> CompiledData [String]
defineInternalCategory :: forall c. AnyCategory c -> CompiledData [String]
defineInternalCategory AnyCategory c
t = forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalCategory2 (CategoryName -> String
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 (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"& " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"() {",
    String
"  static auto& category = *new " forall a. [a] -> [a] -> [a]
++ String
className 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 " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
";",
    String
"S<const " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++
      String
"(const Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
">::Type& params);",
    String
"void " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++
      String
"(const Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n 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 = forall c. String -> AnyCategory c -> Int -> CompiledData [String]
defineInternalType2 (CategoryName -> String
typeName (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 forall a. Ord a => a -> a -> Bool
< Int
1 =
      [String] -> CompiledData [String]
onlyCodes [
        String
"S<const " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(const Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"  static const auto cached = S_get(new " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(), Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
">::Type()));",
        String
"  return cached;",
        String
"}",
        String
"void " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(const Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {}"
      ]
  | Bool
otherwise =
      [String] -> CompiledData [String]
onlyCodes [
        String
"static auto& " forall a. [a] -> [a] -> [a]
++ String
cacheName forall a. [a] -> [a] -> [a]
++ String
" = *new InstanceCache<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
">([](const Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"    return S_get(new " forall a. [a] -> [a] -> [a]
++ String
className forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(), params));",
        String
"  });",
        String
"S<const " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(const Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"  return " forall a. [a] -> [a] -> [a]
++ String
cacheName forall a. [a] -> [a] -> [a]
++ String
".GetOrCreate(params);",
        String
"}",
        String
"void " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeRemover (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"(const Params<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
">::Type& params) {",
        String
"  " forall a. [a] -> [a] -> [a]
++ String
cacheName forall a. [a] -> [a] -> [a]
++ String
".Remove(params);",
        String
"}"
      ] where
        cacheName :: String
cacheName = forall a. Show a => a -> String
show (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) 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 " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++
      String
"(S<const " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> parent, " 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 = forall c. String -> AnyCategory c -> CompiledData [String]
defineInternalValue2 (CategoryName -> String
valueName (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 " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCreator (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++
      String
"(S<const " forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) forall a. [a] -> [a] -> [a]
++ String
"> parent, " forall a. [a] -> [a] -> [a]
++
      String
"const ParamsArgs& params_args) {",
      String
"  return BoxedValue::New<" forall a. [a] -> [a] -> [a]
++ String
className 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 = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall {c}. [ValueRefine c] -> [CategoryName]
fromRefines (forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t) forall a. [a] -> [a] -> [a]
++
                                       forall {c}. [ValueDefine c] -> [CategoryName]
fromDefines (forall c. AnyCategory c -> [ValueDefine c]
getCategoryDefines AnyCategory c
t) forall a. [a] -> [a] -> [a]
++
                                       forall {c}. [ScopedFunction c] -> [CategoryName]
fromFunctions (forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t) forall a. [a] -> [a] -> [a]
++
                                       forall {c}. [ParamFilter c] -> [CategoryName]
fromFilters (forall c. AnyCategory c -> [ParamFilter c]
getCategoryFilters AnyCategory c
t) where
  fromRefines :: [ValueRefine c] -> [CategoryName]
fromRefines [ValueRefine c]
rs = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TypeInstance -> Set CategoryName
categoriesFromRefine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ValueRefine c -> TypeInstance
vrType) [ValueRefine c]
rs
  fromDefines :: [ValueDefine c] -> [CategoryName]
fromDefines [ValueDefine c]
ds = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (DefinesInstance -> Set CategoryName
categoriesFromDefine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ValueDefine c -> DefinesInstance
vdType) [ValueDefine c]
ds
  fromDefine :: DefinesInstance -> [CategoryName]
fromDefine (DefinesInstance CategoryName
d InstanceParams
ps) = CategoryName
dforall a. a -> [a] -> [a]
:([GeneralInstance] -> [CategoryName]
fromGenerals forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues InstanceParams
ps)
  fromFunctions :: [ScopedFunction c] -> [CategoryName]
fromFunctions [ScopedFunction c]
fs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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] forall a. [a] -> [a] -> [a]
++ ([GeneralInstance] -> [CategoryName]
fromGenerals forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ValueType -> GeneralInstance
vtType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. PassedValue c -> ValueType
pvType) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. Positional a -> [a]
pValues Positional (PassedValue c, Maybe (CallArgLabel c))
as) forall a. [a] -> [a] -> [a]
++ forall a. Positional a -> [a]
pValues Positional (PassedValue c)
rs)) forall a. [a] -> [a] -> [a]
++ forall {c}. [ParamFilter c] -> [CategoryName]
fromFilters [ParamFilter c]
fs
  fromFilters :: [ParamFilter c] -> [CategoryName]
fromFilters [ParamFilter c]
fs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (TypeFilter -> [CategoryName]
fromFilter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ParamFilter c -> TypeFilter
pfFilter) [ParamFilter c]
fs
  fromFilter :: TypeFilter -> [CategoryName]
fromFilter (TypeFilter FilterDirection
_ GeneralInstance
t2)  = forall a. Set a -> [a]
Set.toList 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 = forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes