{- -----------------------------------------------------------------------------
Copyright 2019-2021 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 #-}
{-# LANGUAGE Safe #-}

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

import Data.List (intercalate,sortBy)
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 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 -> [String]
coOutput :: [String]
  }
  deriving (Int -> CxxOutput -> ShowS
[CxxOutput] -> ShowS
CxxOutput -> String
(Int -> CxxOutput -> ShowS)
-> (CxxOutput -> String)
-> ([CxxOutput] -> ShowS)
-> Show CxxOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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 {
    FileContext c -> Bool
fcTesting :: Bool,
    FileContext c -> CategoryMap c
fcCategories :: CategoryMap c,
    FileContext c -> Set Namespace
fcNamespaces :: Set.Set Namespace,
    FileContext c -> ExprMap c
fcExprMap :: ExprMap c
  }

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

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

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

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

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

compileCategoryDeclaration :: (Ord c, Show c, CollectErrorsM m) =>
  Bool -> Set.Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration :: Bool -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing Set Namespace
ns AnyCategory c
t =
  CxxOutput -> m CxxOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                     (CategoryName -> String
headerFilename CategoryName
name)
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                     (CompiledData [String] -> Set CategoryName
forall s. CompiledData s -> Set CategoryName
cdRequired CompiledData [String]
file)
                     (CompiledData [String] -> [String]
forall s. CompiledData s -> s
cdOutput CompiledData [String]
file) where
    file :: CompiledData [String]
file = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat ([CompiledData [String]] -> CompiledData [String])
-> [CompiledData [String]] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
        Set CategoryName -> [String] -> CompiledData [String]
forall s. Set CategoryName -> s -> CompiledData s
CompiledData Set CategoryName
depends [],
        [String] -> CompiledData [String]
onlyCodes [String]
guardTop,
        [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ (if Bool
testing then CategoryName -> [String]
testsOnlyCategoryGuard (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) else []),
        [String] -> CompiledData [String]
onlyCodes [String]
baseHeaderIncludes,
        AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t CompiledData [String]
content,
        [String] -> CompiledData [String]
onlyCodes [String]
guardBottom
      ]
    depends :: Set CategoryName
depends = AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryDeps AnyCategory c
t
    content :: CompiledData [String]
content = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [CompiledData [String]
collection,CompiledData [String]
labels,CompiledData [String]
getCategory2,CompiledData [String]
getType]
    name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    guardTop :: [String]
guardTop = [String
"#ifndef " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName,String
"#define " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardBottom :: [String]
guardBottom = [String
"#endif  // " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardName]
    guardName :: String
guardName = String
"HEADER_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
guardNamespace String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
name
    guardNamespace :: String
guardNamespace
      | Namespace -> Bool
isStaticNamespace (Namespace -> Bool) -> Namespace -> Bool
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t = Namespace -> String
forall a. Show a => a -> String
show (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"
      | Bool
otherwise = String
""
    labels :: CompiledData [String]
labels = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> String) -> [ScopedFunction c] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> String
forall c. ScopedFunction c -> String
label ([ScopedFunction c] -> [String]) -> [ScopedFunction c] -> [String]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryName
name) (CategoryName -> Bool)
-> (ScopedFunction c -> CategoryName) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
    label :: ScopedFunction c -> String
label ScopedFunction c
f = String
"extern " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionLabelType ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    collection :: CompiledData [String]
collection
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise         = [String] -> CompiledData [String]
onlyCodes [String
"extern const CollectionType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
collectionName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]
    getCategory2 :: CompiledData [String]
getCategory2
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise             = AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareGetCategory AnyCategory c
t
    getType :: CompiledData [String]
getType
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise             = AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareGetType AnyCategory c
t

data CategoryDefinition c =
  NativeInterface {
    CategoryDefinition c -> AnyCategory c
niCategory :: AnyCategory c
  } |
  NativeConcrete {
    CategoryDefinition c -> AnyCategory c
ncCategory :: AnyCategory c,
    CategoryDefinition c -> DefinedCategory c
ncDefined :: DefinedCategory c,
    CategoryDefinition c -> CategoryMap c
ncCategories :: CategoryMap c,
    CategoryDefinition c -> Set Namespace
ncNamespaces :: Set.Set Namespace,
    CategoryDefinition c -> ExprMap c
ncExprMap :: ExprMap c
  } |
  StreamlinedExtension {
    CategoryDefinition c -> AnyCategory c
seCategory :: AnyCategory c,
    ncNamespaces :: Set.Set Namespace
  } |
  StreamlinedTemplate {
    CategoryDefinition c -> AnyCategory c
stCategory :: AnyCategory c,
    CategoryDefinition c -> CategoryMap c
stCategories :: CategoryMap c
  }

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

  defineFunctions :: AnyCategory c
-> [ScopedFunction c]
-> [ScopedFunction c]
-> [ScopedFunction c]
-> m (CompiledData [String])
defineFunctions AnyCategory c
t [ScopedFunction c]
cf [ScopedFunction c]
tf [ScopedFunction c]
vf = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [m (CompiledData [String])
createCollection,m (CompiledData [String])
createAllLabels] where
    name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    createCollection :: m (CompiledData [String])
createCollection = CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [
        String
"namespace {",
        String
"const int " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
collectionValName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = 0;",
        String
"}  // namespace",
        String
"const CollectionType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
collectionName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = COLLECTION_ID(&" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
collectionValName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");"
      ]
    createAllLabels :: m (CompiledData [String])
createAllLabels = CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ([ScopedFunction c] -> [String])
-> [[ScopedFunction c]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map [ScopedFunction c] -> [String]
forall c. [ScopedFunction c] -> [String]
createLabels [[ScopedFunction c]
cf,[ScopedFunction c]
tf,[ScopedFunction c]
vf]
    collectionValName :: String
collectionValName = String
"collection_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
name
    createLabels :: [ScopedFunction c] -> [String]
createLabels = ((Int, ScopedFunction c) -> String)
-> [(Int, ScopedFunction c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> ScopedFunction c -> String)
-> (Int, ScopedFunction c) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ScopedFunction c -> String
forall c. Int -> ScopedFunction c -> String
createLabelForFunction) ([(Int, ScopedFunction c)] -> [String])
-> ([ScopedFunction c] -> [(Int, ScopedFunction c)])
-> [ScopedFunction c]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [ScopedFunction c] -> [(Int, ScopedFunction c)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([ScopedFunction c] -> [(Int, ScopedFunction c)])
-> ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c]
-> [(Int, ScopedFunction c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c -> ScopedFunction c -> Ordering)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ScopedFunction c -> ScopedFunction c -> Ordering
forall c c. ScopedFunction c -> ScopedFunction c -> Ordering
compareName ([ScopedFunction c] -> [ScopedFunction c])
-> ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c]
-> [ScopedFunction c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryName
name) (CategoryName -> Bool)
-> (ScopedFunction c -> CategoryName) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType)
    compareName :: ScopedFunction c -> ScopedFunction c -> Ordering
compareName ScopedFunction c
x ScopedFunction c
y = ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
x FunctionName -> FunctionName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
y

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

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

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

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

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

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

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

  defineAbstractCategory :: AnyCategory c -> m (CompiledData [String])
defineAbstractCategory AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
categoryBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareCategoryOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ScopedFunction c -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
Bool -> ScopedFunction c -> m (CompiledData [String])
procedureDeclaration Bool
True) ([ScopedFunction c] -> [m (CompiledData [String])])
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope)(SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  virtual inline ~" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() {}",
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]
  defineAbstractType :: AnyCategory c -> m (CompiledData [String])
defineAbstractType AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", std::enable_shared_from_this<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareTypeOverrides,
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CompiledData [String]
forall c. AnyCategory c -> CompiledData [String]
declareTypeArgGetters AnyCategory c
t,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ScopedFunction c -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
Bool -> ScopedFunction c -> m (CompiledData [String])
procedureDeclaration Bool
True) ([ScopedFunction c] -> [m (CompiledData [String])])
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope)(SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  virtual inline ~" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() {}",
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [ValueParam c] -> CompiledData [String]
forall c. [ValueParam c] -> CompiledData [String]
createParams ([ValueParam c] -> CompiledData [String])
-> [ValueParam c] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& parent;",
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ] where
      className :: String
className = CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
  defineAbstractValue :: AnyCategory c -> m (CompiledData [String])
defineAbstractValue AnyCategory c
t = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"struct " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
valueBase String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
AnyCategory c -> m (CompiledData [String])
abstractValueConstructor AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
declareValueOverrides,
      (CompiledData [String] -> CompiledData [String])
-> m (CompiledData [String]) -> m (CompiledData [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompiledData [String] -> CompiledData [String]
indentCompiled (m (CompiledData [String]) -> m (CompiledData [String]))
-> m (CompiledData [String]) -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CollectErrorsM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM ([m (CompiledData [String])] -> m (CompiledData [String]))
-> [m (CompiledData [String])] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (CompiledData [String]))
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ScopedFunction c -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
Bool -> ScopedFunction c -> m (CompiledData [String])
procedureDeclaration Bool
True) ([ScopedFunction c] -> [m (CompiledData [String])])
-> [ScopedFunction c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope)(SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) ([ScopedFunction c] -> [ScopedFunction c])
-> [ScopedFunction c] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t,
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  virtual inline ~" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() {}",
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  const S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> parent;",
      CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
"};"
    ]

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

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

  declareCategoryOverrides :: CompiledData [String]
declareCategoryOverrides = [String] -> CompiledData [String]
onlyCodes [
      String
"  std::string CategoryName() const final;",
      String
"  ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& 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 TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final;",
      String
"  ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) 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 BoxedValue& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) final;"
    ]

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

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

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

  inlineCategoryConstructor :: AnyCategory c
-> DefinedCategory c
-> CategoryMap c
-> ExprMap c
-> m (CompiledData [String])
inlineCategoryConstructor AnyCategory c
t DefinedCategory c
d CategoryMap c
tm ExprMap c
em = do
    ProcedureContext c
ctx <- CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
getContextForInit CategoryMap c
tm ExprMap c
em AnyCategory c
t DefinedCategory c
d SymbolScope
CategoryScope
    CompiledData [String]
initMembers <- CompilerState (ProcedureContext c) m [()]
-> ProcedureContext c -> m (CompiledData [String])
forall c (m :: * -> *) s a b.
CompilerContext c m s a =>
CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler ([StateT (ProcedureContext c) m ()]
-> CompilerState (ProcedureContext c) m [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([StateT (ProcedureContext c) m ()]
 -> CompilerState (ProcedureContext c) m [()])
-> [StateT (ProcedureContext c) m ()]
-> CompilerState (ProcedureContext c) m [()]
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> StateT (ProcedureContext c) m ())
-> [DefinedMember c] -> [StateT (ProcedureContext c) m ()]
forall a b. (a -> b) -> [a] -> [b]
map DefinedMember c -> StateT (ProcedureContext c) m ()
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ CompiledData [String] -> [String]
forall s. CompiledData s -> s
cdOutput CompiledData [String]
initMembers
    let initColon :: String
initColon = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
initMembersStr then String
"" else String
" : "
    CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
initColon String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
initMembersStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)),
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ CategoryName -> SymbolScope -> String
startInitTracing (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) SymbolScope
CategoryScope,
        String -> CompiledData [String]
onlyCode String
"}",
        CompiledData [String] -> CompiledData [String]
clearCompiled CompiledData [String]
initMembers -- Inherit required types.
      ] where
        members :: [DefinedMember c]
members = (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope)(SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember c] -> [DefinedMember c])
-> [DefinedMember c] -> [DefinedMember c]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d
  inlineTypeConstructor :: AnyCategory c -> m (CompiledData [String])
inlineTypeConstructor AnyCategory c
t = do
    let ps2 :: [ParamName]
ps2 = (ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
    let argParent :: String
argParent = CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"& p"
    let paramsPassed :: String
paramsPassed = String
"Params<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([ParamName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ParamName]
ps2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">::Type params"
    let allArgs :: String
allArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
paramsPassed]
    let initParent :: String
initParent = String
"parent(p)"
    let initPassed :: [String]
initPassed = ((Int, ParamName) -> String) -> [(Int, ParamName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,ParamName
p) -> ParamName -> String
paramName ParamName
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(std::get<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">(params))") ([(Int, ParamName)] -> [String]) -> [(Int, ParamName)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [ParamName] -> [(Int, ParamName)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [ParamName]
ps2
    let allInit :: String
allInit = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
initParentString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
initPassed
    CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
        String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allArgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allInit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {",
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)),
        CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ CategoryName -> SymbolScope -> String
startInitTracing (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) SymbolScope
TypeScope,
        String -> CompiledData [String]
onlyCode String
"}"
      ]
  inlineValueConstructor :: AnyCategory c -> DefinedCategory c -> m (CompiledData [String])
inlineValueConstructor AnyCategory c
t DefinedCategory c
d = do
    let argParent :: String
argParent = String
"S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> p"
    let argsPassed :: String
argsPassed = String
"const ValueTuple& args"
    let allArgs :: String
allArgs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String
argParent,String
argsPassed]
    let initParent :: String
initParent = String
"parent(p)"
    let initArgs :: [String]
initArgs = ((Int, DefinedMember c) -> String)
-> [(Int, DefinedMember c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,DefinedMember c
m) -> VariableName -> String
variableName (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> DefinedMember c -> String
forall a c. Show a => a -> DefinedMember c -> String
unwrappedArg Int
i DefinedMember c
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")") ([(Int, DefinedMember c)] -> [String])
-> [(Int, DefinedMember c)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [DefinedMember c] -> [(Int, DefinedMember c)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [DefinedMember c]
members
    let allInit :: String
allInit = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
initParentString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
initArgs
    CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"inline " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allArgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
allInit String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" {}" where
      unwrappedArg :: a -> DefinedMember c -> String
unwrappedArg a
i DefinedMember c
m = ValueType -> ExpressionValue -> String
writeStoredVariable (DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) (String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"args.At(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
      members :: [DefinedMember c]
members = (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope)(SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember c] -> [DefinedMember c])
-> [DefinedMember c] -> [DefinedMember c]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d

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

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

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

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

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

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

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

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

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

createFunctionDispatch :: CategoryName -> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch :: CategoryName
-> SymbolScope -> [ScopedFunction c] -> CompiledData [String]
createFunctionDispatch CategoryName
n SymbolScope
s [ScopedFunction c]
fs = CompiledData [String]
function where
  function :: CompiledData [String]
function
    | [ScopedFunction c] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScopedFunction c]
filtered = String -> CompiledData [String]
onlyCode String
fallback
    | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String
typedef] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((CategoryName, [ScopedFunction c]) -> [String])
-> [(CategoryName, [ScopedFunction c])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName, [ScopedFunction c]) -> [String]
forall c. (CategoryName, [ScopedFunction c]) -> [String]
table ([(CategoryName, [ScopedFunction c])] -> [[String]])
-> [(CategoryName, [ScopedFunction c])] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [(CategoryName, [ScopedFunction c])]
byCategory) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
metaTable [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
select
  filtered :: [ScopedFunction c]
filtered = (ScopedFunction c -> Bool)
-> [ScopedFunction c] -> [ScopedFunction c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
s) (SymbolScope -> Bool)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope) [ScopedFunction c]
fs
  flatten :: ScopedFunction c -> [ScopedFunction c]
flatten ScopedFunction c
f = ScopedFunction c
fScopedFunction c -> [ScopedFunction c] -> [ScopedFunction c]
forall a. a -> [a] -> [a]
:([[ScopedFunction c]] -> [ScopedFunction c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ScopedFunction c]] -> [ScopedFunction c])
-> [[ScopedFunction c]] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> [ScopedFunction c])
-> [ScopedFunction c] -> [[ScopedFunction c]]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> [ScopedFunction c]
flatten ([ScopedFunction c] -> [[ScopedFunction c]])
-> [ScopedFunction c] -> [[ScopedFunction c]]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> [ScopedFunction c]
forall c. ScopedFunction c -> [ScopedFunction c]
sfMerges ScopedFunction c
f)
  flattened :: [ScopedFunction c]
flattened = [[ScopedFunction c]] -> [ScopedFunction c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ScopedFunction c]] -> [ScopedFunction c])
-> [[ScopedFunction c]] -> [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> [ScopedFunction c])
-> [ScopedFunction c] -> [[ScopedFunction c]]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> [ScopedFunction c]
forall c. ScopedFunction c -> [ScopedFunction c]
flatten [ScopedFunction c]
filtered
  byCategory :: [(CategoryName, [ScopedFunction c])]
byCategory = Map CategoryName [ScopedFunction c]
-> [(CategoryName, [ScopedFunction c])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map CategoryName [ScopedFunction c]
 -> [(CategoryName, [ScopedFunction c])])
-> Map CategoryName [ScopedFunction c]
-> [(CategoryName, [ScopedFunction c])]
forall a b. (a -> b) -> a -> b
$ ([ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c])
-> [(CategoryName, [ScopedFunction c])]
-> Map CategoryName [ScopedFunction c]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
(++) ([(CategoryName, [ScopedFunction c])]
 -> Map CategoryName [ScopedFunction c])
-> [(CategoryName, [ScopedFunction c])]
-> Map CategoryName [ScopedFunction c]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> (CategoryName, [ScopedFunction c]))
-> [ScopedFunction c] -> [(CategoryName, [ScopedFunction c])]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f,[ScopedFunction c
f])) [ScopedFunction c]
flattened
  typedef :: String
typedef
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"  using CallType = ReturnTuple(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryName CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const ParamTuple&, const ValueTuple&);"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"  using CallType = ReturnTuple(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"  using CallType = ReturnTuple(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
"::*)(const BoxedValue&, const ParamTuple&, const ValueTuple&);"
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined
  name :: FunctionName -> String
name FunctionName
f
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = CategoryName -> String
categoryName CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = CategoryName -> String
typeName CategoryName
n     String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = CategoryName -> String
valueName CategoryName
n    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName FunctionName
f
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined
  table :: (CategoryName, [ScopedFunction c]) -> [String]
table (CategoryName
n2,[ScopedFunction c]
fs2) =
    [String
"  static const CallType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
tableName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[] = {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    (FunctionName -> String) -> [FunctionName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\FunctionName
f -> String
"    &" String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
name FunctionName
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",") (Set FunctionName -> [FunctionName]
forall a. Set a -> [a]
Set.toList (Set FunctionName -> [FunctionName])
-> Set FunctionName -> [FunctionName]
forall a b. (a -> b) -> a -> b
$ [FunctionName] -> Set FunctionName
forall a. Ord a => [a] -> Set a
Set.fromList ([FunctionName] -> Set FunctionName)
-> [FunctionName] -> Set FunctionName
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> FunctionName)
-> [ScopedFunction c] -> [FunctionName]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName [ScopedFunction c]
fs2) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String
"  };"]
  metaTable :: [String]
metaTable = [String
"  static DispatchTable<CallType> all_tables[] = {"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
              ((CategoryName, [ScopedFunction c]) -> String)
-> [(CategoryName, [ScopedFunction c])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName, [ScopedFunction c]) -> String
forall b. (CategoryName, b) -> String
dispatchKeyValue [(CategoryName, [ScopedFunction c])]
byCategory [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
              [String
"  };"]
  dispatchKeyValue :: (CategoryName, b) -> String
dispatchKeyValue (CategoryName
n2,b
_) = String
"    DispatchTable<CallType>(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
collectionName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
tableName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"),"
  select :: [String]
select = [
      String
"  static const StaticSort force_sort = all_tables;",
      String
"  const DispatchTable<CallType>* const table = DispatchSelect(label.collection, all_tables);",
      String
"  if (table) {",
      String
"    if (label.function_num < 0 || label.function_num >= table->size) {",
      String
"      FAIL() << \"Bad function call \" << label;",
      String
"    } else {",
      String
"      return (this->*table->table[label.function_num])(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");",
      String
"    }",
      String
"  }",
      String
fallback
    ]
  args :: String
args
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"params, args"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"self, params, args"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"self, params, args"
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined
  fallback :: String
fallback
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"  return TypeCategory::Dispatch(label, params, args);"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"  return TypeInstance::Dispatch(self, label, params, args);"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope    = String
"  return TypeValue::Dispatch(self, label, params, args);"
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined

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

declareTypeArgGetters :: AnyCategory c -> CompiledData [String]
declareTypeArgGetters :: AnyCategory c -> CompiledData [String]
declareTypeArgGetters AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ (CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> String
forall a. Show a => a -> String
paramGetter (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
tCategoryName -> [CategoryName] -> [CategoryName]
forall a. a -> [a] -> [a]
:[CategoryName]
refines) where
  refines :: [CategoryName]
refines = (ValueRefine c -> CategoryName)
-> [ValueRefine c] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInstance -> CategoryName
tiName  (TypeInstance -> CategoryName)
-> (ValueRefine c -> TypeInstance) -> ValueRefine c -> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueRefine c -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType) ([ValueRefine c] -> [CategoryName])
-> [ValueRefine c] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t
  paramGetter :: a -> String
paramGetter a
r = String
"  void Params_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(std::vector<S<const TypeInstance>>& args) const;"

defineTypeArgGetters :: AnyCategory c -> CompiledData [String]
defineTypeArgGetters :: AnyCategory c -> CompiledData [String]
defineTypeArgGetters AnyCategory c
t = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ((CategoryName, [GeneralInstance]) -> [String])
-> [(CategoryName, [GeneralInstance])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (CategoryName, [GeneralInstance]) -> [String]
forall a. Show a => (a, [GeneralInstance]) -> [String]
paramGetter ((CategoryName, [GeneralInstance])
myType(CategoryName, [GeneralInstance])
-> [(CategoryName, [GeneralInstance])]
-> [(CategoryName, [GeneralInstance])]
forall a. a -> [a] -> [a]
:[(CategoryName, [GeneralInstance])]
refines) where
  params :: [(ParamName, Variance)]
params = (ValueParam c -> (ParamName, Variance))
-> [ValueParam c] -> [(ParamName, Variance)]
forall a b. (a -> b) -> [a] -> [b]
map (\ValueParam c
p -> (ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam c
p,ValueParam c -> Variance
forall c. ValueParam c -> Variance
vpVariance ValueParam c
p)) ([ValueParam c] -> [(ParamName, Variance)])
-> [ValueParam c] -> [(ParamName, Variance)]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
  myType :: (CategoryName, [GeneralInstance])
myType = (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t,((ParamName, Variance) -> GeneralInstance)
-> [(ParamName, Variance)] -> [GeneralInstance]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> ((ParamName, Variance) -> TypeInstanceOrParam)
-> (ParamName, Variance)
-> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False (ParamName -> TypeInstanceOrParam)
-> ((ParamName, Variance) -> ParamName)
-> (ParamName, Variance)
-> TypeInstanceOrParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamName, Variance) -> ParamName
forall a b. (a, b) -> a
fst) [(ParamName, Variance)]
params)
  refines :: [(CategoryName, [GeneralInstance])]
refines = (TypeInstance -> (CategoryName, [GeneralInstance]))
-> [TypeInstance] -> [(CategoryName, [GeneralInstance])]
forall a b. (a -> b) -> [a] -> [b]
map (\TypeInstance
r -> (TypeInstance -> CategoryName
tiName TypeInstance
r,InstanceParams -> [GeneralInstance]
forall a. Positional a -> [a]
pValues (InstanceParams -> [GeneralInstance])
-> InstanceParams -> [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ TypeInstance -> InstanceParams
tiParams TypeInstance
r)) ([TypeInstance] -> [(CategoryName, [GeneralInstance])])
-> [TypeInstance] -> [(CategoryName, [GeneralInstance])]
forall a b. (a -> b) -> a -> b
$ (ValueRefine c -> TypeInstance)
-> [ValueRefine c] -> [TypeInstance]
forall a b. (a -> b) -> [a] -> [b]
map ValueRefine c -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType ([ValueRefine c] -> [TypeInstance])
-> [ValueRefine c] -> [TypeInstance]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t
  paramGetter :: (a, [GeneralInstance]) -> [String]
paramGetter (a
r,[GeneralInstance]
ps) = [
      String
"void " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::Params_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(std::vector<S<const TypeInstance>>& args) const {",
      String
"  args = std::vector<S<const TypeInstance>>{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((GeneralInstance -> String) -> [GeneralInstance] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> String
expandLocalType [GeneralInstance]
ps) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"};",
      String
"}"
    ]

createTypeArgsForParent :: AnyCategory c -> CompiledData [String]
createTypeArgsForParent :: AnyCategory c -> CompiledData [String]
createTypeArgsForParent AnyCategory c
t
  | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"  return false;"
  | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
      String
"  using CallType = void(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::*)(std::vector<S<const TypeInstance>>&)const;",
      String
"  static DispatchSingle<CallType> all_calls[] = {"
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> String
dispatchKeyValue ((AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)CategoryName -> [CategoryName] -> [CategoryName]
forall a. a -> [a] -> [a]
:[CategoryName]
refines) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"  };",
      String
"  static const StaticSort force_sort = all_calls;",
      String
"  const DispatchSingle<CallType>* const call = DispatchSelect(&category, all_calls);",
      String
"  if (call) {",
      String
"    (this->*call->value)(args);",
      String
"    return true;",
      String
"  }",
      String
"  return false;"
    ] where
      className :: String
className = CategoryName -> String
typeName (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
      refines :: [CategoryName]
refines = (ValueRefine c -> CategoryName)
-> [ValueRefine c] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInstance -> CategoryName
tiName (TypeInstance -> CategoryName)
-> (ValueRefine c -> TypeInstance) -> ValueRefine c -> CategoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueRefine c -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType) ([ValueRefine c] -> [CategoryName])
-> [ValueRefine c] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t
      dispatchKeyValue :: CategoryName -> String
dispatchKeyValue CategoryName
n = String
"    DispatchSingle<CallType>(&" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryGetter CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
"(), &" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
className String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::Params_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"),"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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