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

module CompilerCxx.Category (
  CxxOutput(..),
  LanguageModule(..),
  PrivateSource(..),
  compileCategoryDeclaration,
  compileLanguageModule,
  compileConcreteDefinition,
  compileConcreteTemplate,
  compileInterfaceDefinition,
  compileModuleMain,
  compileTestMain,
) where

import Control.Monad (foldM,when)
import Data.List (intercalate,sortBy)
import Prelude hiding (pi)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompileError
import Base.MergeTree
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.GeneralType
import Types.Positional
import Types.Pragma
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 -> [Namespace]
coUsesNamespace :: [Namespace],
    CxxOutput -> [CategoryName]
coUsesCategory :: [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 LanguageModule c =
  LanguageModule {
    LanguageModule c -> [Namespace]
lmPublicNamespaces :: [Namespace],
    LanguageModule c -> [Namespace]
lmPrivateNamespaces :: [Namespace],
    LanguageModule c -> [Namespace]
lmLocalNamespaces :: [Namespace],
    LanguageModule c -> [AnyCategory c]
lmPublicDeps :: [AnyCategory c],
    LanguageModule c -> [AnyCategory c]
lmPrivateDeps :: [AnyCategory c],
    LanguageModule c -> [AnyCategory c]
lmTestingDeps :: [AnyCategory c],
    LanguageModule c -> [AnyCategory c]
lmPublicLocal :: [AnyCategory c],
    LanguageModule c -> [AnyCategory c]
lmPrivateLocal :: [AnyCategory c],
    LanguageModule c -> [AnyCategory c]
lmTestingLocal :: [AnyCategory c],
    LanguageModule c -> [CategoryName]
lmExternal :: [CategoryName],
    LanguageModule c -> [CategoryName]
lmStreamlined :: [CategoryName],
    LanguageModule c -> ExprMap c
lmExprMap :: ExprMap c
  }

data PrivateSource c =
  PrivateSource {
    PrivateSource c -> Namespace
psNamespace :: Namespace,
    PrivateSource c -> Bool
psTesting :: Bool,
    PrivateSource c -> [AnyCategory c]
psCategory :: [AnyCategory c],
    PrivateSource c -> [DefinedCategory c]
psDefine :: [DefinedCategory c]
  }

compileLanguageModule :: (Show c, CompileErrorM m) =>
  LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
compileLanguageModule :: LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
compileLanguageModule (LanguageModule [Namespace]
ns0 [Namespace]
ns1 [Namespace]
ns2 [AnyCategory c]
cs0 [AnyCategory c]
ps0 [AnyCategory c]
ts0 [AnyCategory c]
cs1 [AnyCategory c]
ps1 [AnyCategory c]
ts1 [CategoryName]
ex [CategoryName]
ss ExprMap c
em) [PrivateSource c]
xa = do
  [CategoryName] -> m ()
forall (m :: * -> *) a. (CompileErrorM m, Show a) => [a] -> m ()
checkSupefluous ([CategoryName] -> m ()) -> [CategoryName] -> m ()
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList (Set CategoryName -> [CategoryName])
-> Set CategoryName -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
ex) Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set CategoryName
ca
  -- Check public sources up front so that error messages aren't duplicated for
  -- every source file.
  CategoryMap c
ta <- m (CategoryMap c)
tmTesting
  [CxxOutput]
xx1 <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[CxxOutput]] -> m [CxxOutput])
-> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ (AnyCategory c -> m [CxxOutput])
-> [AnyCategory c] -> m [[CxxOutput]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Bool
-> m (CategoryMap c)
-> [Namespace]
-> AnyCategory c
-> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CompileErrorM m) =>
Bool
-> m (CategoryMap c)
-> [Namespace]
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
False m (CategoryMap c)
tmPublic  [Namespace]
nsPublic)  [AnyCategory c]
cs1
  [CxxOutput]
xx2 <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[CxxOutput]] -> m [CxxOutput])
-> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ (AnyCategory c -> m [CxxOutput])
-> [AnyCategory c] -> m [[CxxOutput]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Bool
-> m (CategoryMap c)
-> [Namespace]
-> AnyCategory c
-> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CompileErrorM m) =>
Bool
-> m (CategoryMap c)
-> [Namespace]
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
False m (CategoryMap c)
tmPrivate [Namespace]
nsPrivate) [AnyCategory c]
ps1
  [CxxOutput]
xx3 <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[CxxOutput]] -> m [CxxOutput])
-> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ (AnyCategory c -> m [CxxOutput])
-> [AnyCategory c] -> m [[CxxOutput]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Bool
-> m (CategoryMap c)
-> [Namespace]
-> AnyCategory c
-> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CompileErrorM m) =>
Bool
-> m (CategoryMap c)
-> [Namespace]
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
True  m (CategoryMap c)
tmTesting [Namespace]
nsTesting) [AnyCategory c]
ts1
  ([DefinedCategory c]
ds,[CxxOutput]
xx4) <- ([([DefinedCategory c], [CxxOutput])]
 -> ([DefinedCategory c], [CxxOutput]))
-> m [([DefinedCategory c], [CxxOutput])]
-> m ([DefinedCategory c], [CxxOutput])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([DefinedCategory c], [CxxOutput])]
-> ([DefinedCategory c], [CxxOutput])
forall a a. [([a], [a])] -> ([a], [a])
mergeGeneratedX (m [([DefinedCategory c], [CxxOutput])]
 -> m ([DefinedCategory c], [CxxOutput]))
-> m [([DefinedCategory c], [CxxOutput])]
-> m ([DefinedCategory c], [CxxOutput])
forall a b. (a -> b) -> a -> b
$ (PrivateSource c -> m ([DefinedCategory c], [CxxOutput]))
-> [PrivateSource c] -> m [([DefinedCategory c], [CxxOutput])]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM PrivateSource c -> m ([DefinedCategory c], [CxxOutput])
compileSourceX [PrivateSource c]
xa
  [CxxOutput]
xx5 <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[CxxOutput]] -> m [CxxOutput])
-> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ (CategoryName -> m [CxxOutput])
-> [CategoryName] -> m [[CxxOutput]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (\CategoryName
s -> Bool -> CategoryMap c -> CategoryName -> m [CxxOutput]
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool -> CategoryMap c -> CategoryName -> m [CxxOutput]
compileConcreteStreamlined (CategoryName
s CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
testingCats) CategoryMap c
ta CategoryName
s) [CategoryName]
ss
  -- TODO: This should account for a name clash between a category declared in a
  -- TestsOnly .0rp and one declared in a non-TestOnly .0rx.
  let dm :: Map CategoryName [DefinedCategory c]
dm = [DefinedCategory c] -> Map CategoryName [DefinedCategory c]
forall c.
[DefinedCategory c] -> Map CategoryName [DefinedCategory c]
mapByName [DefinedCategory c]
ds
  Map CategoryName [DefinedCategory c]
-> [CategoryName] -> [AnyCategory c] -> m ()
forall (m :: * -> *) a a.
(CompileErrorM m, Show a, Show a) =>
Map CategoryName [DefinedCategory a]
-> [CategoryName] -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory c]
dm [CategoryName]
ex ([AnyCategory c] -> m ()) -> [AnyCategory c] -> m ()
forall a b. (a -> b) -> a -> b
$ (AnyCategory c -> Bool) -> [AnyCategory c] -> [AnyCategory c]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete ([AnyCategory c]
cs1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ps1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ts1)
  m ()
checkStreamlined
  [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
$ [CxxOutput]
xx1 [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xx2 [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xx3 [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xx4 [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xx5 where
    testingCats :: Set CategoryName
testingCats = [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
$ (AnyCategory c -> CategoryName)
-> [AnyCategory c] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName [AnyCategory c]
ts1
    tmPublic :: m (CategoryMap c)
tmPublic  = (CategoryMap c -> [AnyCategory c] -> m (CategoryMap c))
-> CategoryMap c -> [[AnyCategory c]] -> m (CategoryMap c)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
forall c. CategoryMap c
defaultCategories [[AnyCategory c]
cs0,[AnyCategory c]
cs1]
    tmPrivate :: m (CategoryMap c)
tmPrivate = m (CategoryMap c)
tmPublic  m (CategoryMap c)
-> (CategoryMap c -> m (CategoryMap c)) -> m (CategoryMap c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CategoryMap c
tm -> (CategoryMap c -> [AnyCategory c] -> m (CategoryMap c))
-> CategoryMap c -> [[AnyCategory c]] -> m (CategoryMap c)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tm [[AnyCategory c]
ps0,[AnyCategory c]
ps1]
    tmTesting :: m (CategoryMap c)
tmTesting = m (CategoryMap c)
tmPrivate m (CategoryMap c)
-> (CategoryMap c -> m (CategoryMap c)) -> m (CategoryMap c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CategoryMap c
tm -> (CategoryMap c -> [AnyCategory c] -> m (CategoryMap c))
-> CategoryMap c -> [[AnyCategory c]] -> m (CategoryMap c)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tm [[AnyCategory c]
ts0,[AnyCategory c]
ts1]
    nsPublic :: [Namespace]
nsPublic = [Namespace]
ns0 [Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++ [Namespace]
ns2
    nsPrivate :: [Namespace]
nsPrivate = [Namespace]
nsPublic [Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++ [Namespace]
ns1
    nsTesting :: [Namespace]
nsTesting = [Namespace]
nsPrivate
    compileSourceP :: Bool
-> m (CategoryMap c)
-> [Namespace]
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
testing m (CategoryMap c)
tm [Namespace]
ns AnyCategory c
c = do
      CategoryMap c
tm' <- m (CategoryMap c)
tm
      CxxOutput
hxx <- Bool
-> CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing CategoryMap c
tm' [Namespace]
ns AnyCategory c
c
      [CxxOutput]
cxx <- if AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete AnyCategory c
c
                then [CxxOutput] -> m [CxxOutput]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                else Bool -> AnyCategory c -> m CxxOutput
forall (m :: * -> *) c.
CompileErrorM m =>
Bool -> AnyCategory c -> m CxxOutput
compileInterfaceDefinition Bool
testing AnyCategory c
c m CxxOutput -> (CxxOutput -> m [CxxOutput]) -> m [CxxOutput]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CxxOutput] -> m [CxxOutput]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CxxOutput] -> m [CxxOutput])
-> (CxxOutput -> [CxxOutput]) -> CxxOutput -> m [CxxOutput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[])
      [CxxOutput] -> m [CxxOutput]
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
hxxCxxOutput -> [CxxOutput] -> [CxxOutput]
forall a. a -> [a] -> [a]
:[CxxOutput]
cxx)
    compileSourceX :: PrivateSource c -> m ([DefinedCategory c], [CxxOutput])
compileSourceX (PrivateSource Namespace
ns Bool
testing [AnyCategory c]
cs2 [DefinedCategory c]
ds) = do
      CategoryMap c
tm <- if Bool
testing
               then m (CategoryMap c)
tmTesting
               else m (CategoryMap c)
tmPrivate
      let ns4 :: [Namespace]
ns4 = if Bool
testing
                then [Namespace]
nsTesting
                else [Namespace]
nsPrivate
      let cs :: [AnyCategory c]
cs = if Bool
testing
                  then [AnyCategory c]
cs1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ps1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ts1
                  else [AnyCategory c]
cs1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ps1
      [DefinedCategory c] -> [CategoryName] -> m ()
forall (m :: * -> *) a.
(CompileErrorM m, Show a) =>
[DefinedCategory a] -> [CategoryName] -> m ()
checkLocals [DefinedCategory c]
ds ([CategoryName]
ex [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++ (AnyCategory c -> CategoryName)
-> [AnyCategory c] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName ([AnyCategory c]
cs2 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
cs))
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
testing (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [DefinedCategory c] -> [AnyCategory c] -> m ()
forall (m :: * -> *) a a.
(CompileErrorM m, Show a, Show a) =>
[DefinedCategory a] -> [AnyCategory a] -> m ()
checkTests [DefinedCategory c]
ds ([AnyCategory c]
cs1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ps1)
      let dm :: Map CategoryName [DefinedCategory c]
dm = [DefinedCategory c] -> Map CategoryName [DefinedCategory c]
forall c.
[DefinedCategory c] -> Map CategoryName [DefinedCategory c]
mapByName [DefinedCategory c]
ds
      Map CategoryName [DefinedCategory c]
-> [CategoryName] -> [AnyCategory c] -> m ()
forall (m :: * -> *) a a.
(CompileErrorM m, Show a, Show a) =>
Map CategoryName [DefinedCategory a]
-> [CategoryName] -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory c]
dm [] ([AnyCategory c] -> m ()) -> [AnyCategory c] -> m ()
forall a b. (a -> b) -> a -> b
$ (AnyCategory c -> Bool) -> [AnyCategory c] -> [AnyCategory c]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete [AnyCategory c]
cs2
      CategoryMap c
tm' <- CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tm [AnyCategory c]
cs2
      -- Ensures that there isn't an inavertent collision when resolving
      -- dependencies for the module later on.
      CategoryMap c
tmTesting' <- m (CategoryMap c)
tmTesting
      CategoryMap c
_ <- (CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tmTesting' [AnyCategory c]
cs2)
      [CxxOutput]
hxx <- (AnyCategory c -> m CxxOutput) -> [AnyCategory c] -> m [CxxOutput]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Bool
-> CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing CategoryMap c
tm' [Namespace]
ns4) [AnyCategory c]
cs2
      let interfaces :: [AnyCategory c]
interfaces = (AnyCategory c -> Bool) -> [AnyCategory c] -> [AnyCategory c]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (AnyCategory c -> Bool) -> AnyCategory c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete) [AnyCategory c]
cs2
      [CxxOutput]
cxx1 <- (AnyCategory c -> m CxxOutput) -> [AnyCategory c] -> m [CxxOutput]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Bool -> AnyCategory c -> m CxxOutput
forall (m :: * -> *) c.
CompileErrorM m =>
Bool -> AnyCategory c -> m CxxOutput
compileInterfaceDefinition Bool
testing) [AnyCategory c]
interfaces
      [CxxOutput]
cxx2 <- (DefinedCategory c -> m CxxOutput)
-> [DefinedCategory c] -> m [CxxOutput]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Bool
-> CategoryMap c -> [Namespace] -> DefinedCategory c -> m CxxOutput
forall (m :: * -> *).
CompileErrorM m =>
Bool
-> CategoryMap c -> [Namespace] -> DefinedCategory c -> m CxxOutput
compileDefinition Bool
testing CategoryMap c
tm' (Namespace
nsNamespace -> [Namespace] -> [Namespace]
forall a. a -> [a] -> [a]
:[Namespace]
ns4)) [DefinedCategory c]
ds
      ([DefinedCategory c], [CxxOutput])
-> m ([DefinedCategory c], [CxxOutput])
forall (m :: * -> *) a. Monad m => a -> m a
return ([DefinedCategory c]
ds,[CxxOutput]
hxx [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
cxx1 [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
cxx2)
    mergeGeneratedX :: [([a], [a])] -> ([a], [a])
mergeGeneratedX (([a]
ds,[a]
xx):[([a], [a])]
xs2) = let ([a]
ds2,[a]
xx2) = [([a], [a])] -> ([a], [a])
mergeGeneratedX [([a], [a])]
xs2 in ([a]
ds[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
ds2,[a]
xx[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
xx2)
    mergeGeneratedX [([a], [a])]
_             = ([],[])
    compileDefinition :: Bool
-> CategoryMap c -> [Namespace] -> DefinedCategory c -> m CxxOutput
compileDefinition Bool
testing CategoryMap c
tm [Namespace]
ns4 DefinedCategory c
d = do
      CategoryMap c
tm' <- CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance CategoryMap c
tm DefinedCategory c
d
      let refines :: Maybe [ValueRefine c]
refines = DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d CategoryName -> CategoryMap c -> Maybe (AnyCategory c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` CategoryMap c
tm Maybe (AnyCategory c)
-> (AnyCategory c -> Maybe [ValueRefine c])
-> Maybe [ValueRefine c]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValueRefine c] -> Maybe [ValueRefine c]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueRefine c] -> Maybe [ValueRefine c])
-> (AnyCategory c -> [ValueRefine c])
-> AnyCategory c
-> Maybe [ValueRefine c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines
      Bool
-> CategoryMap c
-> ExprMap c
-> [Namespace]
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c
-> ExprMap c
-> [Namespace]
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
compileConcreteDefinition Bool
testing CategoryMap c
tm' ExprMap c
em [Namespace]
ns4 Maybe [ValueRefine c]
refines DefinedCategory c
d
    mapByName :: [DefinedCategory c] -> Map CategoryName [DefinedCategory c]
mapByName = ([DefinedCategory c] -> [DefinedCategory c] -> [DefinedCategory c])
-> [(CategoryName, [DefinedCategory c])]
-> Map CategoryName [DefinedCategory c]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [DefinedCategory c] -> [DefinedCategory c] -> [DefinedCategory c]
forall a. [a] -> [a] -> [a]
(++) ([(CategoryName, [DefinedCategory c])]
 -> Map CategoryName [DefinedCategory c])
-> ([DefinedCategory c] -> [(CategoryName, [DefinedCategory c])])
-> [DefinedCategory c]
-> Map CategoryName [DefinedCategory c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefinedCategory c -> (CategoryName, [DefinedCategory c]))
-> [DefinedCategory c] -> [(CategoryName, [DefinedCategory c])]
forall a b. (a -> b) -> [a] -> [b]
map (\DefinedCategory c
d -> (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d,[DefinedCategory c
d]))
    ca :: Set CategoryName
ca = [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
$ (AnyCategory c -> CategoryName)
-> [AnyCategory c] -> [CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName ([AnyCategory c] -> [CategoryName])
-> [AnyCategory c] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ (AnyCategory c -> Bool) -> [AnyCategory c] -> [AnyCategory c]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete ([AnyCategory c]
cs1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ps1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ts1)
    checkLocals :: [DefinedCategory a] -> [CategoryName] -> m ()
checkLocals [DefinedCategory a]
ds [CategoryName]
cs2 = (DefinedCategory a -> m ()) -> [DefinedCategory a] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (Set CategoryName -> DefinedCategory a -> m ()
forall (f :: * -> *) a.
(CompileErrorM f, Show a) =>
Set CategoryName -> DefinedCategory a -> f ()
checkLocal (Set CategoryName -> DefinedCategory a -> m ())
-> Set CategoryName -> DefinedCategory a -> m ()
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
cs2) [DefinedCategory a]
ds
    checkLocal :: Set CategoryName -> DefinedCategory a -> f ()
checkLocal Set CategoryName
cs2 DefinedCategory a
d =
      Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DefinedCategory a -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory a
d CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
cs2) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
        String -> f ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String
"Definition for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (DefinedCategory a -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory a
d) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       String
" does not correspond to a visible category in this module")
    checkTests :: [DefinedCategory a] -> [AnyCategory a] -> m ()
checkTests [DefinedCategory a]
ds [AnyCategory a]
ps = do
      let pa :: Map CategoryName [a]
pa = [(CategoryName, [a])] -> Map CategoryName [a]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CategoryName, [a])] -> Map CategoryName [a])
-> [(CategoryName, [a])] -> Map CategoryName [a]
forall a b. (a -> b) -> a -> b
$ (AnyCategory a -> (CategoryName, [a]))
-> [AnyCategory a] -> [(CategoryName, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\AnyCategory a
c -> (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
c,AnyCategory a -> [a]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory a
c)) ([AnyCategory a] -> [(CategoryName, [a])])
-> [AnyCategory a] -> [(CategoryName, [a])]
forall a b. (a -> b) -> a -> b
$ (AnyCategory a -> Bool) -> [AnyCategory a] -> [AnyCategory a]
forall a. (a -> Bool) -> [a] -> [a]
filter AnyCategory a -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete [AnyCategory a]
ps
      (DefinedCategory a -> m ()) -> [DefinedCategory a] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (Map CategoryName [a] -> DefinedCategory a -> m ()
forall (m :: * -> *) a a.
(CompileErrorM m, Show a, Show a) =>
Map CategoryName [a] -> DefinedCategory a -> m ()
checkTest Map CategoryName [a]
pa) [DefinedCategory a]
ds
    checkTest :: Map CategoryName [a] -> DefinedCategory a -> m ()
checkTest Map CategoryName [a]
pa DefinedCategory a
d =
      case DefinedCategory a -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory a
d CategoryName -> Map CategoryName [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map CategoryName [a]
pa of
           Maybe [a]
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Just [a]
c  ->
             String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (DefinedCategory a -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory a
d) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                            [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                            String
" was not declared as $TestsOnly$" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c)
    checkDefined :: Map CategoryName [DefinedCategory a]
-> [CategoryName] -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory a]
dm [CategoryName]
ex2 = (AnyCategory a -> m ()) -> [AnyCategory a] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (Map CategoryName [DefinedCategory a]
-> Set CategoryName -> AnyCategory a -> m ()
forall (m :: * -> *) a a.
(CompileErrorM m, Show a, Show a) =>
Map CategoryName [DefinedCategory a]
-> Set CategoryName -> AnyCategory a -> m ()
checkSingle Map CategoryName [DefinedCategory a]
dm ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
ex2))
    checkSingle :: Map CategoryName [DefinedCategory a]
-> Set CategoryName -> AnyCategory a -> m ()
checkSingle Map CategoryName [DefinedCategory a]
dm Set CategoryName
es AnyCategory a
t =
      case (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
es, AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t CategoryName
-> Map CategoryName [DefinedCategory a]
-> Maybe [DefinedCategory a]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map CategoryName [DefinedCategory a]
dm) of
           (Bool
False,Just [DefinedCategory a
_]) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           (Bool
True,Maybe [DefinedCategory a]
Nothing)   -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           (Bool
True,Just [DefinedCategory a
d]) ->
             String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (AnyCategory a -> [a]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory a
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
" was declared external but is also defined at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d))
           (Bool
False,Maybe [DefinedCategory a]
Nothing) ->
             String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (AnyCategory a -> [a]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory a
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                           String
" has not been defined or declared external")
           (Bool
_,Just [DefinedCategory a]
ds) ->
             (String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
              [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (AnyCategory a -> [a]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory a
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
" is defined " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([DefinedCategory a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DefinedCategory a]
ds) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" times") String -> m () -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
!!>
               ((DefinedCategory a -> m Any) -> [DefinedCategory a] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (\DefinedCategory a
d -> String -> m Any
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m Any) -> String -> m Any
forall a b. (a -> b) -> a -> b
$ String
"Defined at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d)) [DefinedCategory a]
ds)
    checkSupefluous :: [a] -> m ()
checkSupefluous [a]
es2
      | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
es2 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"External categories either not concrete or not present: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
es2)
    checkStreamlined :: m ()
checkStreamlined =  (CategoryName -> m Any) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_  CategoryName -> m Any
forall (m :: * -> *) a a. (CompileErrorM m, Show a) => a -> m a
streamlinedError ([CategoryName] -> m ()) -> [CategoryName] -> m ()
forall a b. (a -> b) -> a -> b
$ 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 -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
Set.difference ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
ss) ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
ex)
    streamlinedError :: a -> m a
streamlinedError a
n =
      String -> m a
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cannot be streamlined because it was not declared external"

compileTestMain :: (Show c, CompileErrorM m) =>
  LanguageModule c -> PrivateSource c -> Expression c -> m CxxOutput
compileTestMain :: LanguageModule c -> PrivateSource c -> Expression c -> m CxxOutput
compileTestMain (LanguageModule [Namespace]
ns0 [Namespace]
ns1 [Namespace]
ns2 [AnyCategory c]
cs0 [AnyCategory c]
ps0 [AnyCategory c]
ts0 [AnyCategory c]
cs1 [AnyCategory c]
ps1 [AnyCategory c]
ts1 [CategoryName]
_ [CategoryName]
_ ExprMap c
em) PrivateSource c
ts2 Expression c
e = do
  CategoryMap c
tm' <- m (CategoryMap c)
tm
  ([CategoryName]
req,[String]
main) <- CategoryMap c
-> ExprMap c -> Expression c -> m ([CategoryName], [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c
-> ExprMap c -> Expression c -> m ([CategoryName], [String])
createTestFile CategoryMap c
tm' ExprMap c
em Expression c
e
  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
-> [Namespace]
-> [CategoryName]
-> [String]
-> CxxOutput
CxxOutput Maybe CategoryName
forall a. Maybe a
Nothing String
testFilename Namespace
NoNamespace ([PrivateSource c -> Namespace
forall c. PrivateSource c -> Namespace
psNamespace PrivateSource c
ts2][Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++[Namespace]
ns0[Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++[Namespace]
ns1[Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++[Namespace]
ns2) [CategoryName]
req [String]
main where
  tm :: m (CategoryMap c)
tm = (CategoryMap c -> [AnyCategory c] -> m (CategoryMap c))
-> CategoryMap c -> [[AnyCategory c]] -> m (CategoryMap c)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
forall c. CategoryMap c
defaultCategories [[AnyCategory c]
cs0,[AnyCategory c]
cs1,[AnyCategory c]
ps0,[AnyCategory c]
ps1,[AnyCategory c]
ts0,[AnyCategory c]
ts1,PrivateSource c -> [AnyCategory c]
forall c. PrivateSource c -> [AnyCategory c]
psCategory PrivateSource c
ts2]

compileModuleMain :: (Show c, CompileErrorM m) =>
  LanguageModule c -> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput
compileModuleMain :: LanguageModule c
-> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput
compileModuleMain (LanguageModule [Namespace]
ns0 [Namespace]
ns1 [Namespace]
ns2 [AnyCategory c]
cs0 [AnyCategory c]
ps0 [AnyCategory c]
_ [AnyCategory c]
cs1 [AnyCategory c]
ps1 [AnyCategory c]
_ [CategoryName]
_ [CategoryName]
_ ExprMap c
em) [PrivateSource c]
xa CategoryName
n FunctionName
f = do
  let resolved :: [DefinedCategory c]
resolved = (DefinedCategory c -> Bool)
-> [DefinedCategory c] -> [DefinedCategory c]
forall a. (a -> Bool) -> [a] -> [a]
filter (\DefinedCategory c
d -> DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryName
n) ([DefinedCategory c] -> [DefinedCategory c])
-> [DefinedCategory c] -> [DefinedCategory c]
forall a b. (a -> b) -> a -> b
$ [[DefinedCategory c]] -> [DefinedCategory c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[DefinedCategory c]] -> [DefinedCategory c])
-> [[DefinedCategory c]] -> [DefinedCategory c]
forall a b. (a -> b) -> a -> b
$ (PrivateSource c -> [DefinedCategory c])
-> [PrivateSource c] -> [[DefinedCategory c]]
forall a b. (a -> b) -> [a] -> [b]
map PrivateSource c -> [DefinedCategory c]
forall c. PrivateSource c -> [DefinedCategory c]
psDefine ([PrivateSource c] -> [[DefinedCategory c]])
-> [PrivateSource c] -> [[DefinedCategory c]]
forall a b. (a -> b) -> a -> b
$ (PrivateSource c -> Bool) -> [PrivateSource c] -> [PrivateSource c]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (PrivateSource c -> Bool) -> PrivateSource c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateSource c -> Bool
forall c. PrivateSource c -> Bool
psTesting) [PrivateSource c]
xa
  [DefinedCategory c] -> m ()
forall (m :: * -> *) a.
(CompileErrorM m, Show a) =>
[DefinedCategory a] -> m ()
reconcile [DefinedCategory c]
resolved
  CategoryMap c
tm' <- m (CategoryMap c)
tm
  let cs :: [AnyCategory c]
cs = (AnyCategory c -> Bool) -> [AnyCategory c] -> [AnyCategory c]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AnyCategory c
c -> AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
c CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== CategoryName
n) ([AnyCategory c] -> [AnyCategory c])
-> [AnyCategory c] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ [[AnyCategory c]] -> [AnyCategory c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AnyCategory c]] -> [AnyCategory c])
-> [[AnyCategory c]] -> [AnyCategory c]
forall a b. (a -> b) -> a -> b
$ (PrivateSource c -> [AnyCategory c])
-> [PrivateSource c] -> [[AnyCategory c]]
forall a b. (a -> b) -> [a] -> [b]
map PrivateSource c -> [AnyCategory c]
forall c. PrivateSource c -> [AnyCategory c]
psCategory [PrivateSource c]
xa
  CategoryMap c
tm'' <- CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tm' [AnyCategory c]
cs
  (Namespace
ns,[String]
main) <- CategoryMap c
-> ExprMap c
-> CategoryName
-> FunctionName
-> m (Namespace, [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c
-> ExprMap c
-> CategoryName
-> FunctionName
-> m (Namespace, [String])
createMainFile CategoryMap c
tm'' ExprMap c
em CategoryName
n FunctionName
f
  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
-> [Namespace]
-> [CategoryName]
-> [String]
-> CxxOutput
CxxOutput Maybe CategoryName
forall a. Maybe a
Nothing String
mainFilename Namespace
NoNamespace ([Namespace
ns][Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++[Namespace]
ns0[Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++[Namespace]
ns1[Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++[Namespace]
ns2) [CategoryName
n] [String]
main where
    tm :: m (CategoryMap c)
tm = (CategoryMap c -> [AnyCategory c] -> m (CategoryMap c))
-> CategoryMap c -> [[AnyCategory c]] -> m (CategoryMap c)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
forall c. CategoryMap c
defaultCategories [[AnyCategory c]
cs0,[AnyCategory c]
cs1,[AnyCategory c]
ps0,[AnyCategory c]
ps1]
    reconcile :: [DefinedCategory a] -> m ()
reconcile [DefinedCategory a
_] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    reconcile []  = String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"No matches for main category " 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
" ($TestsOnly$ sources excluded)"
    reconcile [DefinedCategory a]
ds  =
      (String
"Multiple matches for main category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n) String -> m () -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
!!>
        (DefinedCategory a -> m Any) -> [DefinedCategory a] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (\DefinedCategory a
d -> String -> m Any
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m Any) -> String -> m Any
forall a b. (a -> b) -> a -> b
$ String
"Defined at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d)) [DefinedCategory a]
ds

compileCategoryDeclaration :: (Show c, CompileErrorM m) =>
  Bool -> CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration :: Bool
-> CategoryMap c -> [Namespace] -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing CategoryMap c
_ [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
-> [Namespace]
-> [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)
                     ([Namespace]
ns [Namespace] -> [Namespace] -> [Namespace]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t])
                     (Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList (Set CategoryName -> [CategoryName])
-> Set CategoryName -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ 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 = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String]
collection [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
labels [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
getCategory2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [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 :: [String]
labels = (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 :: [String]
collection
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isValueConcrete AnyCategory c
t = []
      | Bool
otherwise         = [String
"extern const void* const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
collectionName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"]
    getCategory2 :: [String]
getCategory2
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = []
      | Bool
otherwise             = AnyCategory c -> [String]
forall c. AnyCategory c -> [String]
declareGetCategory AnyCategory c
t
    getType :: [String]
getType
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = []
      | Bool
otherwise             = AnyCategory c -> [String]
forall c. AnyCategory c -> [String]
declareGetType AnyCategory c
t

compileInterfaceDefinition :: CompileErrorM m => Bool -> AnyCategory c -> m CxxOutput
compileInterfaceDefinition :: Bool -> AnyCategory c -> m CxxOutput
compileInterfaceDefinition Bool
testing AnyCategory c
t = do
  CompiledData [String]
te <- m (CompiledData [String])
typeConstructor
  Bool
-> AnyCategory c
-> [Namespace]
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
forall (m :: * -> *) c.
CompileErrorM m =>
Bool
-> AnyCategory c
-> [Namespace]
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
commonDefineAll Bool
testing AnyCategory c
t [] Maybe [ValueRefine c]
forall a. Maybe a
Nothing CompiledData [String]
emptyCode CompiledData [String]
emptyCode CompiledData [String]
emptyCode CompiledData [String]
te []
  where
    typeConstructor :: m (CompiledData [String])
typeConstructor = do
      let ps :: [ParamName]
ps = (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 argsPassed :: String
argsPassed = 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]
ps) 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
argsPassed]
      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]
ps
      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
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ 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
" {}"

compileConcreteTemplate :: (Show c, CompileErrorM m) =>
  Bool -> CategoryMap c -> CategoryName -> m CxxOutput
compileConcreteTemplate :: Bool -> CategoryMap c -> CategoryName -> m CxxOutput
compileConcreteTemplate Bool
testing CategoryMap c
ta CategoryName
n = do
  ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
ta ([],CategoryName
n)
  Bool
-> CategoryMap c
-> ExprMap c
-> [Namespace]
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c
-> ExprMap c
-> [Namespace]
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
compileConcreteDefinition Bool
testing CategoryMap c
ta ExprMap c
forall k a. Map k a
Map.empty [] Maybe [ValueRefine c]
forall a. Maybe a
Nothing (AnyCategory c -> DefinedCategory c
forall c c. AnyCategory c -> DefinedCategory c
defined AnyCategory c
t) m CxxOutput -> String -> m CxxOutput
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<?? (String
"In generated template for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n) where
    defined :: AnyCategory c -> DefinedCategory c
defined AnyCategory c
t = DefinedCategory :: forall c.
[c]
-> CategoryName
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [DefinedMember c]
-> [ExecutableProcedure c]
-> [ScopedFunction c]
-> DefinedCategory c
DefinedCategory {
        dcContext :: [c]
dcContext = [],
        dcName :: CategoryName
dcName = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t,
        dcParams :: [ValueParam c]
dcParams = [],
        dcRefines :: [ValueRefine c]
dcRefines = [],
        dcDefines :: [ValueDefine c]
dcDefines = [],
        dcParamFilter :: [ParamFilter c]
dcParamFilter = [],
        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. 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]
-> [Pragma c]
-> [c]
-> FunctionName
-> ArgValues c
-> ReturnValues c
-> Procedure c
-> ExecutableProcedure c
ExecutableProcedure {
        epContext :: [c]
epContext = [],
        epPragmas :: [Pragma 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. 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 [] [
        [c] -> VoidExpression c -> Statement c
forall c. [c] -> VoidExpression c -> Statement c
NoValueExpression [] (VoidExpression c -> Statement c)
-> VoidExpression c -> Statement c
forall a b. (a -> b) -> a -> b
$ String -> VoidExpression c
forall c. String -> VoidExpression c
LineComment (String -> VoidExpression c) -> String -> VoidExpression c
forall a b. (a -> b) -> a -> b
$ String
"TODO: Implement " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
funcName ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".",
        [c] -> Expression c -> Statement c
forall c. [c] -> Expression c -> Statement c
FailCall [] (ValueLiteral c -> Expression c
forall c. ValueLiteral c -> Expression c
Literal ([c] -> String -> ValueLiteral c
forall c. [c] -> String -> ValueLiteral c
StringLiteral [] (String -> ValueLiteral c) -> String -> ValueLiteral c
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> String
forall c. ScopedFunction c -> String
funcName ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not implemented"))
      ]
    funcName :: ScopedFunction c -> String
funcName ScopedFunction c
f = CategoryName -> String
forall a. Show a => a -> String
show (ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f)

compileConcreteStreamlined :: (Show c, CompileErrorM m) =>
  Bool -> CategoryMap c -> CategoryName -> m [CxxOutput]
compileConcreteStreamlined :: Bool -> CategoryMap c -> CategoryName -> m [CxxOutput]
compileConcreteStreamlined Bool
testing CategoryMap c
ta CategoryName
n =  (String
"In streamlined compilation of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n) String -> m [CxxOutput] -> m [CxxOutput]
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
??> do
  ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
ta ([],CategoryName
n)
  let guard :: [String]
guard = if Bool
testing
                 then [String]
testsOnlySourceGuard
                 else [String]
noTestsOnlySourceGuard
  -- TODO: Implement this.
  let hxx :: CxxOutput
hxx = Maybe CategoryName
-> String
-> Namespace
-> [Namespace]
-> [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
headerStreamlined (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 -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                      [AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t]
                      (AnyCategory c -> [CategoryName]
forall c. AnyCategory c -> [CategoryName]
getCategoryMentions AnyCategory c
t)
                      [String]
guard
  let cxx :: CxxOutput
cxx = Maybe CategoryName
-> String
-> Namespace
-> [Namespace]
-> [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
sourceStreamlined (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 -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                      [AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t]
                      (AnyCategory c -> [CategoryName]
forall c. AnyCategory c -> [CategoryName]
getCategoryMentions AnyCategory c
t)
                      []
  [CxxOutput] -> m [CxxOutput]
forall (m :: * -> *) a. Monad m => a -> m a
return [CxxOutput
hxx,CxxOutput
cxx]

compileConcreteDefinition :: (Show c, CompileErrorM m) =>
  Bool -> CategoryMap c -> ExprMap c -> [Namespace] -> Maybe [ValueRefine c] ->
  DefinedCategory c -> m CxxOutput
compileConcreteDefinition :: Bool
-> CategoryMap c
-> ExprMap c
-> [Namespace]
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
compileConcreteDefinition Bool
testing CategoryMap c
ta ExprMap c
em [Namespace]
ns Maybe [ValueRefine c]
rs dd :: DefinedCategory c
dd@(DefinedCategory [c]
c CategoryName
n [ValueParam c]
pi [ValueRefine c]
_ [ValueDefine c]
_ [ParamFilter c]
fi [DefinedMember c]
ms [ExecutableProcedure c]
_ [ScopedFunction c]
fs) = do
  ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
ta ([c]
c,CategoryName
n)
  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, CompileErrorM m) =>
CategoryMap c
-> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
getProcedureScopes CategoryMap c
ta ExprMap c
em DefinedCategory c
dd
  let ([DefinedMember c]
cm,[DefinedMember c]
tm,[DefinedMember c]
vm) = (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
  let filters :: [ParamFilter c]
filters = AnyCategory c -> [ParamFilter c]
forall c. AnyCategory c -> [ParamFilter c]
getCategoryFilters AnyCategory c
t
  let filters2 :: [ParamFilter c]
filters2 = [ParamFilter c]
fi
  ParamFilters
allFilters <- [ValueParam c] -> [ParamFilter c] -> m ParamFilters
forall (m :: * -> *) c.
CompileErrorM m =>
[ValueParam c] -> [ParamFilter c] -> m ParamFilters
getFilterMap (AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t [ValueParam c] -> [ValueParam c] -> [ValueParam c]
forall a. [a] -> [a] -> [a]
++ [ValueParam c]
pi) ([ParamFilter c] -> m ParamFilters)
-> [ParamFilter c] -> m ParamFilters
forall a b. (a -> b) -> a -> b
$ [ParamFilter c]
filters [ParamFilter c] -> [ParamFilter c] -> [ParamFilter c]
forall a. [a] -> [a] -> [a]
++ [ParamFilter c]
filters2
  -- Functions explicitly declared externally.
  let externalFuncs :: Set FunctionName
externalFuncs = [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] -> [FunctionName])
-> [ScopedFunction c] -> [FunctionName]
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
n) (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
  -- Functions explicitly declared internally.
  let overrideFuncs :: Map FunctionName (ScopedFunction c)
overrideFuncs = [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FunctionName, ScopedFunction c)]
 -> Map FunctionName (ScopedFunction c))
-> [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> (FunctionName, ScopedFunction c))
-> [ScopedFunction c] -> [(FunctionName, ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,ScopedFunction c
f)) [ScopedFunction c]
fs
  -- Functions only declared internally.
  let internalFuncs :: Map FunctionName (ScopedFunction c)
internalFuncs = (ScopedFunction c -> Bool)
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (ScopedFunction c -> Bool) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunctionName -> Set FunctionName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FunctionName
externalFuncs) (FunctionName -> Bool)
-> (ScopedFunction c -> FunctionName) -> ScopedFunction c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName) Map FunctionName (ScopedFunction c)
overrideFuncs
  let fe :: [ScopedFunction c]
fe = Map FunctionName (ScopedFunction c) -> [ScopedFunction c]
forall k a. Map k a -> [a]
Map.elems Map FunctionName (ScopedFunction c)
internalFuncs
  let allFuncs :: [ScopedFunction c]
allFuncs = AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++ [ScopedFunction c]
fe
  [(CompiledData [String], CompiledData [String])]
cf <- [m (CompiledData [String], CompiledData [String])]
-> m [(CompiledData [String], CompiledData [String])]
forall (m :: * -> *) (f :: * -> *) a.
(CompileErrorM m, Foldable f) =>
f (m a) -> m [a]
collectAllM ([m (CompiledData [String], CompiledData [String])]
 -> m [(CompiledData [String], CompiledData [String])])
-> [m (CompiledData [String], CompiledData [String])]
-> m [(CompiledData [String], CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String], CompiledData [String]))
-> ProcedureScope c
-> [m (CompiledData [String], CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String], CompiledData [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String], CompiledData [String])
compileExecutableProcedure ProcedureScope c
cp
  CompiledData [String]
ce <- [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      AnyCategory c -> [DefinedMember c] -> m (CompiledData [String])
forall (m :: * -> *).
CompileErrorM m =>
AnyCategory c -> [DefinedMember c] -> m (CompiledData [String])
categoryConstructor AnyCategory c
t [DefinedMember c]
cm,
      [ScopedFunction c] -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
[ScopedFunction c] -> m (CompiledData [String])
categoryDispatch [ScopedFunction c]
allFuncs,
      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 ([CompiledData [String]] -> CompiledData [String])
-> [CompiledData [String]] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ ((CompiledData [String], CompiledData [String])
 -> CompiledData [String])
-> [(CompiledData [String], CompiledData [String])]
-> [CompiledData [String]]
forall a b. (a -> b) -> [a] -> [b]
map (CompiledData [String], CompiledData [String])
-> CompiledData [String]
forall a b. (a, b) -> a
fst [(CompiledData [String], CompiledData [String])]
cf,
      [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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 (CategoryResolver c
-> ParamFilters -> DefinedMember c -> m (CompiledData [String])
forall (m :: * -> *) r c.
(CompileErrorM m, TypeResolver r, Show c) =>
r -> ParamFilters -> DefinedMember c -> m (CompiledData [String])
createMemberLazy CategoryResolver c
r ParamFilters
allFilters) [DefinedMember c]
cm
    ]
  [(CompiledData [String], CompiledData [String])]
tf <- [m (CompiledData [String], CompiledData [String])]
-> m [(CompiledData [String], CompiledData [String])]
forall (m :: * -> *) (f :: * -> *) a.
(CompileErrorM m, Foldable f) =>
f (m a) -> m [a]
collectAllM ([m (CompiledData [String], CompiledData [String])]
 -> m [(CompiledData [String], CompiledData [String])])
-> [m (CompiledData [String], CompiledData [String])]
-> m [(CompiledData [String], CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String], CompiledData [String]))
-> ProcedureScope c
-> [m (CompiledData [String], CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String], CompiledData [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String], CompiledData [String])
compileExecutableProcedure ProcedureScope c
tp
  [DefinedMember c] -> m ()
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
[DefinedMember c] -> m ()
disallowTypeMembers [DefinedMember c]
tm
  CompiledData [String]
te <- [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM m) =>
[m (CompiledData s)] -> m (CompiledData s)
concatM [
      AnyCategory c -> [DefinedMember c] -> m (CompiledData [String])
forall (m :: * -> *).
CompileErrorM m =>
AnyCategory c -> [DefinedMember c] -> m (CompiledData [String])
typeConstructor AnyCategory c
t [DefinedMember c]
tm,
      [ScopedFunction c] -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
[ScopedFunction c] -> m (CompiledData [String])
typeDispatch [ScopedFunction c]
allFuncs,
      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 ([CompiledData [String]] -> CompiledData [String])
-> [CompiledData [String]] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ ((CompiledData [String], CompiledData [String])
 -> CompiledData [String])
-> [(CompiledData [String], CompiledData [String])]
-> [CompiledData [String]]
forall a b. (a -> b) -> [a] -> [b]
map (CompiledData [String], CompiledData [String])
-> CompiledData [String]
forall a b. (a, b) -> a
fst [(CompiledData [String], CompiledData [String])]
tf,
      [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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 (CategoryResolver c
-> ParamFilters -> DefinedMember c -> m (CompiledData [String])
forall (m :: * -> *) r c.
(CompileErrorM m, TypeResolver r, Show c) =>
r -> ParamFilters -> DefinedMember c -> m (CompiledData [String])
createMember CategoryResolver c
r ParamFilters
allFilters) [DefinedMember c]
tm
    ]
  [(CompiledData [String], CompiledData [String])]
vf <- [m (CompiledData [String], CompiledData [String])]
-> m [(CompiledData [String], CompiledData [String])]
forall (m :: * -> *) (f :: * -> *) a.
(CompileErrorM m, Foldable f) =>
f (m a) -> m [a]
collectAllM ([m (CompiledData [String], CompiledData [String])]
 -> m [(CompiledData [String], CompiledData [String])])
-> [m (CompiledData [String], CompiledData [String])]
-> m [(CompiledData [String], CompiledData [String])]
forall a b. (a -> b) -> a -> b
$ (ScopeContext c
 -> ScopedFunction c
 -> ExecutableProcedure c
 -> m (CompiledData [String], CompiledData [String]))
-> ProcedureScope c
-> [m (CompiledData [String], CompiledData [String])]
forall c a.
(ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String], CompiledData [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String], CompiledData [String])
compileExecutableProcedure ProcedureScope c
vp
  let internalCount :: Int
internalCount = [ValueParam c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValueParam c]
pi
  let memberCount :: Int
memberCount = [DefinedMember c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DefinedMember c]
vm
  CompiledData [String]
top <- [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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
"class " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";",
      CategoryName -> Int -> Int -> m (CompiledData [String])
forall (m :: * -> *).
Monad m =>
CategoryName -> Int -> Int -> m (CompiledData [String])
declareInternalValue CategoryName
n Int
internalCount Int
memberCount
    ]
  CompiledData [String]
defineValue <- [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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 CategoryName
n 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
$ [DefinedMember c] -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
[DefinedMember c] -> m (CompiledData [String])
valueConstructor [DefinedMember c]
vm,
      (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
$ [ScopedFunction c] -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
[ScopedFunction c] -> m (CompiledData [String])
valueDispatch [ScopedFunction c]
allFuncs,
      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
$ SymbolScope -> CategoryName -> CompiledData [String]
defineCategoryName SymbolScope
ValueScope CategoryName
n,
      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
$ [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
$ ((CompiledData [String], CompiledData [String])
 -> CompiledData [String])
-> [(CompiledData [String], CompiledData [String])]
-> [CompiledData [String]]
forall a b. (a -> b) -> [a] -> [b]
map (CompiledData [String], CompiledData [String])
-> CompiledData [String]
forall a b. (a, b) -> a
fst [(CompiledData [String], CompiledData [String])]
vf,
      (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, CompileErrorM 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 (CategoryResolver c
-> ParamFilters -> DefinedMember c -> m (CompiledData [String])
forall (m :: * -> *) r c.
(CompileErrorM m, TypeResolver r, Show c) =>
r -> ParamFilters -> DefinedMember c -> m (CompiledData [String])
createMember CategoryResolver c
r ParamFilters
allFilters) [DefinedMember c]
vm,
      (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])
createParams,
      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
$ 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 CategoryName
n 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
$ 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
$ [(ScopedFunction c, ExecutableProcedure c)] -> [String]
forall a c. [(a, ExecutableProcedure c)] -> [String]
traceCreation (ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
forall c.
ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures ProcedureScope c
vp),
      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]
bottom <- [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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
$ [
      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]
defineValue,
      CategoryName -> Int -> Int -> m (CompiledData [String])
forall (m :: * -> *).
Monad m =>
CategoryName -> Int -> Int -> m (CompiledData [String])
defineInternalValue CategoryName
n Int
internalCount Int
memberCount
    ] [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ ((CompiledData [String], CompiledData [String])
 -> m (CompiledData [String]))
-> [(CompiledData [String], CompiledData [String])]
-> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map (CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> ((CompiledData [String], CompiledData [String])
    -> CompiledData [String])
-> (CompiledData [String], CompiledData [String])
-> m (CompiledData [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompiledData [String], CompiledData [String])
-> CompiledData [String]
forall a b. (a, b) -> b
snd) ([(CompiledData [String], CompiledData [String])]
cf [(CompiledData [String], CompiledData [String])]
-> [(CompiledData [String], CompiledData [String])]
-> [(CompiledData [String], CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [(CompiledData [String], CompiledData [String])]
tf [(CompiledData [String], CompiledData [String])]
-> [(CompiledData [String], CompiledData [String])]
-> [(CompiledData [String], CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [(CompiledData [String], CompiledData [String])]
vf)
  Bool
-> AnyCategory c
-> [Namespace]
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
forall (m :: * -> *) c.
CompileErrorM m =>
Bool
-> AnyCategory c
-> [Namespace]
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
commonDefineAll Bool
testing AnyCategory c
t [Namespace]
ns Maybe [ValueRefine c]
rs CompiledData [String]
top CompiledData [String]
bottom CompiledData [String]
ce CompiledData [String]
te [ScopedFunction c]
fe
  where
    disallowTypeMembers :: (Show c, CompileErrorM m) =>
      [DefinedMember c] -> m ()
    disallowTypeMembers :: [DefinedMember c] -> m ()
disallowTypeMembers [DefinedMember c]
tm =
      [m Any] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CompileErrorM 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. CompileErrorM m => String -> m a
compileErrorM (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))
    createParams :: m (CompiledData [String])
createParams = [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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
$ (ValueParam c -> m (CompiledData [String]))
-> [ValueParam c] -> [m (CompiledData [String])]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> m (CompiledData [String])
forall (m :: * -> *) c.
Monad m =>
ValueParam c -> m (CompiledData [String])
createParam [ValueParam c]
pi
    createParam :: ValueParam c -> m (CompiledData [String])
createParam ValueParam c
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
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
";"
    -- TODO: Can probably remove this if @type members are disallowed. Or, just
    -- skip it if there are no @type members.
    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);"
      ]
    categoryConstructor :: AnyCategory c -> [DefinedMember c] -> m (CompiledData [String])
categoryConstructor AnyCategory c
t [DefinedMember c]
ms2 = do
      ProcedureContext c
ctx <- CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
getContextForInit CategoryMap c
ta ExprMap c
em AnyCategory c
t DefinedCategory c
dd 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.
(Show c, CompileErrorM m, CompilerContext c m [String] a) =>
DefinedMember c -> CompilerState a m ()
compileLazyInit [DefinedMember c]
ms2) 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
" : "
      [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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
$ CategoryName -> String
categoryName CategoryName
n 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] -> 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
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
categoryName CategoryName
n),
          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
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ ShowS
startFunctionTracing ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (init @category)",
          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] -> 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]
clearCompiled CompiledData [String]
initMembers -- Inherit required types.
        ]
    typeConstructor :: AnyCategory c -> [DefinedMember c] -> m (CompiledData [String])
typeConstructor AnyCategory c
t [DefinedMember c]
ms2 = 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 CategoryName
n 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
      ProcedureContext c
ctx <- CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
getContextForInit CategoryMap c
ta ExprMap c
em AnyCategory c
t DefinedCategory c
dd SymbolScope
TypeScope
      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.
(Show c, CompileErrorM m, CompilerContext c m [String] a) =>
DefinedMember c -> CompilerState a m ()
compileRegularInit [DefinedMember c]
ms2) ProcedureContext c
ctx
      [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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
$ CategoryName -> String
typeName CategoryName
n 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] -> 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
$ [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
getCycleCheck (CategoryName -> String
typeName CategoryName
n),
          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
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ ShowS
startFunctionTracing ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (init @type)",
          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
$ CompiledData [String]
initMembers,
          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
"}"
        ]
    valueConstructor :: [DefinedMember c] -> m (CompiledData [String])
valueConstructor [DefinedMember c]
ms2 = do
      let argParent :: String
argParent = String
"S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> p"
      let paramsPassed :: String
paramsPassed = String
"const ParamTuple& params"
      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
paramsPassed,String
argsPassed]
      let initParent :: String
initParent = String
"parent(p)"
      let initParams :: [String]
initParams = ((Int, ValueParam c) -> String)
-> [(Int, ValueParam c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,ValueParam c
p) -> ParamName -> String
paramName (ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam c
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(params.At(" 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
"))") ([(Int, ValueParam c)] -> [String])
-> [(Int, ValueParam c)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [ValueParam c] -> [(Int, ValueParam c)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [ValueParam c]
pi
      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]
ms2
      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]
initParams [String] -> [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
$ CategoryName -> String
valueName CategoryName
n 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
" {}"
    unwrappedArg :: a -> DefinedMember c -> String
unwrappedArg a
i DefinedMember c
m = ValueType -> ExprValue -> String
writeStoredVariable (DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) (String -> ExprValue
UnwrappedSingle (String -> ExprValue) -> String -> ExprValue
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
")")
    createMember :: r -> ParamFilters -> DefinedMember c -> m (CompiledData [String])
createMember r
r ParamFilters
filters DefinedMember c
m = do
      r -> ParamFilters -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CompileErrorM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> m ()
validateGeneralInstance r
r ParamFilters
filters (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. CompileErrorM 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 -> ParamFilters -> DefinedMember c -> m (CompiledData [String])
createMemberLazy r
r ParamFilters
filters DefinedMember c
m = do
      r -> ParamFilters -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CompileErrorM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> m ()
validateGeneralInstance r
r ParamFilters
filters (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. CompileErrorM 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
";"
    categoryDispatch :: [ScopedFunction c] -> m (CompiledData [String])
categoryDispatch [ScopedFunction c]
fs2 =
      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
"ReturnTuple Dispatch(" String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const CategoryFunction& label, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const ParamTuple& params, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const ValueTuple& args) final {"
        ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]
forall c.
CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]
createFunctionDispatch CategoryName
n SymbolScope
CategoryScope [ScopedFunction c]
fs2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
    typeDispatch :: [ScopedFunction c] -> m (CompiledData [String])
typeDispatch [ScopedFunction c]
fs2 =
      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
"ReturnTuple Dispatch(" String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const S<TypeInstance>& self, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const TypeFunction& label, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const ParamTuple& params, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const ValueTuple& args) final {"
        ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]
forall c.
CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]
createFunctionDispatch CategoryName
n SymbolScope
TypeScope [ScopedFunction c]
fs2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
    valueDispatch :: [ScopedFunction c] -> m (CompiledData [String])
valueDispatch [ScopedFunction c]
fs2 =
      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
"ReturnTuple Dispatch(" String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const S<TypeValue>& self, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const ValueFunction& label, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const ParamTuple& params," String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const ValueTuple& args) final {"
        ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]
forall c.
CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]
createFunctionDispatch CategoryName
n SymbolScope
ValueScope [ScopedFunction c]
fs2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
    traceCreation :: [(a, ExecutableProcedure c)] -> [String]
traceCreation [(a, ExecutableProcedure c)]
vp
      | (Pragma c -> Bool) -> [Pragma c] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pragma c -> Bool
forall c. Pragma c -> Bool
isTraceCreation ([Pragma c] -> Bool) -> [Pragma c] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Pragma c]] -> [Pragma c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pragma c]] -> [Pragma c]) -> [[Pragma c]] -> [Pragma c]
forall a b. (a -> b) -> a -> b
$ ((a, ExecutableProcedure c) -> [Pragma c])
-> [(a, ExecutableProcedure c)] -> [[Pragma c]]
forall a b. (a -> b) -> [a] -> [b]
map (ExecutableProcedure c -> [Pragma c]
forall c. ExecutableProcedure c -> [Pragma c]
epPragmas (ExecutableProcedure c -> [Pragma c])
-> ((a, ExecutableProcedure c) -> ExecutableProcedure c)
-> (a, ExecutableProcedure c)
-> [Pragma c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ExecutableProcedure c) -> ExecutableProcedure c
forall a b. (a, b) -> b
snd) [(a, ExecutableProcedure c)]
vp = [String
captureCreationTrace]
      | Bool
otherwise = []

commonDefineAll :: CompileErrorM m =>
  Bool -> AnyCategory c -> [Namespace] -> Maybe [ValueRefine c] ->
  CompiledData [String] -> CompiledData [String] -> CompiledData [String] ->
  CompiledData [String] -> [ScopedFunction c] -> m CxxOutput
commonDefineAll :: Bool
-> AnyCategory c
-> [Namespace]
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
commonDefineAll Bool
testing AnyCategory c
t [Namespace]
ns Maybe [ValueRefine c]
rs CompiledData [String]
top CompiledData [String]
bottom CompiledData [String]
ce CompiledData [String]
te [ScopedFunction c]
fe = do
  let filename :: String
filename = CategoryName -> String
sourceFilename CategoryName
name
  (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, CompileErrorM 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
$ [
      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 ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList (CategoryName
nameCategoryName -> [CategoryName] -> [CategoryName]
forall a. a -> [a] -> [a]
:AnyCategory c -> [CategoryName]
forall c. AnyCategory c -> [CategoryName]
getCategoryMentions 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]
forall a. Monoid a => [a] -> a
mconcat [CompiledData [String]
createCollection,CompiledData [String]
createAllLabels]
    ] [m (CompiledData [String])]
-> [m (CompiledData [String])] -> [m (CompiledData [String])]
forall a. [a] -> [a] -> [a]
++ [m (CompiledData [String])]
conditionalContent
  let rs' :: [ValueRefine c]
rs' = case Maybe [ValueRefine c]
rs of
                 Maybe [ValueRefine c]
Nothing -> []
                 Just [ValueRefine c]
rs2 -> [ValueRefine c]
rs2
  let guard :: [String]
guard = if Bool
testing
                 then [String]
testsOnlySourceGuard
                 else [String]
noTestsOnlySourceGuard
  let inherited :: Set CategoryName
inherited = [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) (AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t [ValueRefine c] -> [ValueRefine c] -> [ValueRefine c]
forall a. [a] -> [a] -> [a]
++ [ValueRefine c]
rs')) [Set CategoryName] -> [Set CategoryName] -> [Set CategoryName]
forall a. [a] -> [a] -> [a]
++
                               ((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] -> [Set CategoryName])
-> [ValueDefine c] -> [Set CategoryName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueDefine c]
forall c. AnyCategory c -> [ValueDefine c]
getCategoryDefines AnyCategory c
t)
  let includes :: [String]
includes = (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 -> [CategoryName])
-> Set CategoryName -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set CategoryName
req Set CategoryName
inherited
  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
-> [Namespace]
-> [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 -> [Namespace] -> [Namespace]
forall a. a -> [a] -> [a]
:[Namespace]
ns)
                     (Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList Set CategoryName
req)
                     ([String]
guard [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
baseSourceIncludes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
includes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
out)
  where
    conditionalContent :: [m (CompiledData [String])]
conditionalContent
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = []
      | Bool
otherwise = [
        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
"namespace {",
        m (CompiledData [String])
declareTypes,
        CategoryName -> Int -> m (CompiledData [String])
forall (m :: * -> *).
Monad m =>
CategoryName -> Int -> m (CompiledData [String])
declareInternalType CategoryName
name Int
paramCount,
        CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
top,
        AnyCategory c -> CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) c.
CompileErrorM m =>
AnyCategory c -> CompiledData [String] -> m (CompiledData [String])
commonDefineCategory AnyCategory c
t CompiledData [String]
ce,
        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]
getInternal,
        AnyCategory c
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> m (CompiledData [String])
forall (m :: * -> *) c.
CompileErrorM m =>
AnyCategory c
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> m (CompiledData [String])
commonDefineType AnyCategory c
t Maybe [ValueRefine c]
rs CompiledData [String]
te,
        CategoryName -> Int -> m (CompiledData [String])
forall (m :: * -> *).
Monad m =>
CategoryName -> Int -> m (CompiledData [String])
defineInternalType CategoryName
name Int
paramCount,
        CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return CompiledData [String]
bottom,
        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
"}  // namespace",
        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]
getCategory2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
getType
      ]
    declareTypes :: m (CompiledData [String])
declareTypes =
      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
$ ((CategoryName -> String) -> String)
-> [CategoryName -> String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\CategoryName -> String
f -> String
"class " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
f CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";") [CategoryName -> String
categoryName,CategoryName -> String
typeName]
    paramCount :: Int
paramCount = [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
    name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    createCollection :: CompiledData [String]
createCollection = [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 void* const " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
collectionName CategoryName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = &" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
collectionValName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
      ]
    collectionValName :: String
collectionValName = String
"collection_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
name
    ([ScopedFunction c]
fc,[ScopedFunction c]
ft,[ScopedFunction c]
fv) = (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 [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++ [ScopedFunction c]
fe
    createAllLabels :: CompiledData [String]
createAllLabels = [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]
fc,[ScopedFunction c]
ft,[ScopedFunction c]
fv]
    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)
    getInternal :: [String]
getInternal = AnyCategory c -> [String]
forall c. AnyCategory c -> [String]
defineInternalCategory AnyCategory c
t
    getCategory2 :: [String]
getCategory2 = AnyCategory c -> [String]
forall c. AnyCategory c -> [String]
defineGetCatetory AnyCategory c
t
    getType :: [String]
getType = AnyCategory c -> [String]
forall c. AnyCategory c -> [String]
defineGetType AnyCategory c
t
    compareName :: ScopedFunction c -> ScopedFunction c -> Ordering
compareName ScopedFunction c
x ScopedFunction c
y = ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
x FunctionName -> FunctionName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
y

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] -> [String]
createFunctionDispatch :: CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]
createFunctionDispatch CategoryName
n SymbolScope
s [ScopedFunction c]
fs = [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]] -> [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 (t :: * -> *) a.
Foldable t =>
(CategoryName, t a) -> [String]
dispatch ([(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
fallback] where
  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 S<TypeValue>&, 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
"  };"]
  dispatch :: (CategoryName, t a) -> [String]
dispatch (CategoryName
n2,t a
fs2) = [
      String
"  if (label.collection == " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
collectionName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {",
      String
"    if (label.function_num < 0 || label.function_num >= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
fs2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") {",
      String
"      FAIL() << \"Bad function call \" << label;",
      String
"    }",
      String
"    return (this->*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
tableName CategoryName
n2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[label.function_num])(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
args String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
");",
      String
"  }"
    ]
  args :: String
args
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String
"params, args"
    | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope     = String
"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

commonDefineCategory :: CompileErrorM m =>
  AnyCategory c -> CompiledData [String] -> m (CompiledData [String])
commonDefineCategory :: AnyCategory c -> CompiledData [String] -> m (CompiledData [String])
commonDefineCategory AnyCategory c
t CompiledData [String]
extra = do
  [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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
$ [
      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 CategoryName
name 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] -> 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
$ SymbolScope -> CategoryName -> CompiledData [String]
defineCategoryName SymbolScope
CategoryScope CategoryName
name,
      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]
extra,
      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
    name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t

commonDefineType :: CompileErrorM m =>
  AnyCategory c -> Maybe [ValueRefine c] -> CompiledData [String] -> m (CompiledData [String])
commonDefineType :: AnyCategory c
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> m (CompiledData [String])
commonDefineType AnyCategory c
t Maybe [ValueRefine c]
rs CompiledData [String]
extra = do
  let rs' :: [ValueRefine c]
rs' = case Maybe [ValueRefine c]
rs of
                 Maybe [ValueRefine c]
Nothing -> AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t
                 Just [ValueRefine c]
rs2 -> [ValueRefine c]
rs2
  [m (CompiledData [String])] -> m (CompiledData [String])
forall s (m :: * -> *).
(Semigroup s, Monoid s, CompileErrorM 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
$ Set CategoryName -> [String] -> CompiledData [String]
forall s. Set CategoryName -> s -> CompiledData s
CompiledData Set CategoryName
depends [],
      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] -> 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
$ SymbolScope -> CategoryName -> CompiledData [String]
defineCategoryName SymbolScope
TypeScope CategoryName
name,
      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
$ CategoryName -> [ParamName] -> CompiledData [String]
defineTypeName CategoryName
name ((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),
      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
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ 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
$ CompiledData [String] -> CompiledData [String]
indentCompiled CompiledData [String]
createParams,
      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]
canConvertFrom,
      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
$ [ValueRefine c] -> CompiledData [String]
forall c. [ValueRefine c] -> CompiledData [String]
typeArgsForParent [ValueRefine c]
rs',
      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]
extra,
      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
    name :: CategoryName
name = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t
    depends :: Set CategoryName
depends = AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryDeps AnyCategory c
t
    createParams :: CompiledData [String]
createParams = [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
$ (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 ([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
    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
";"
    canConvertFrom :: CompiledData [String]
canConvertFrom
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
          String
"bool CanConvertFrom(const S<const TypeInstance>& from) const final {",
          -- TODO: This should be a typedef.
          String
"  std::vector<S<const TypeInstance>> args;",
          String
"  if (!from->TypeArgsForParent(parent, args)) return false;",
          -- TODO: Create a helper function for this error.
          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;",String
"}"]
    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;"
    typeArgsForParent :: [ValueRefine c] -> CompiledData [String]
typeArgsForParent [ValueRefine c]
rs2
      | AnyCategory c -> Bool
forall c. AnyCategory c -> Bool
isInstanceInterface AnyCategory c
t = CompiledData [String]
emptyCode
      | Bool
otherwise = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
          String
"bool TypeArgsForParent(" String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"const TypeCategory& category, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"std::vector<S<const TypeInstance>>& args) const final {"
        ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ValueRefine c] -> [String]
forall c. [ValueRefine c] -> [String]
allCats [ValueRefine c]
rs2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"  return false;",String
"}"]
    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 :: [ValueRefine c] -> [(CategoryName, [GeneralInstance])]
refines [ValueRefine c]
rs2 = (TypeInstance -> (CategoryName, [GeneralInstance]))
-> [TypeInstance] -> [(CategoryName, [GeneralInstance])]
forall a b. (a -> b) -> [a] -> [b]
map (\TypeInstance
r -> (TypeInstance -> CategoryName
tiName TypeInstance
r,Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues (Positional GeneralInstance -> [GeneralInstance])
-> Positional GeneralInstance -> [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ TypeInstance -> Positional GeneralInstance
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]
rs2
    allCats :: [ValueRefine c] -> [String]
allCats [ValueRefine c]
rs2 = [[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]
singleCat ((CategoryName, [GeneralInstance])
myType(CategoryName, [GeneralInstance])
-> [(CategoryName, [GeneralInstance])]
-> [(CategoryName, [GeneralInstance])]
forall a. a -> [a] -> [a]
:[ValueRefine c] -> [(CategoryName, [GeneralInstance])]
forall c. [ValueRefine c] -> [(CategoryName, [GeneralInstance])]
refines [ValueRefine c]
rs2)
    singleCat :: (CategoryName, [GeneralInstance]) -> [String]
singleCat (CategoryName
t2,[GeneralInstance]
ps) = [
        String
"  if (&category == &" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryGetter CategoryName
t2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"()) {",
        String
"    args = std::vector<S<const TypeInstance>>{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expanded String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"};",
        String
"    return true;",
        String
"  }"
      ]
      where
        expanded :: String
expanded = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> String) -> [GeneralInstance] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> String
expandLocalType [GeneralInstance]
ps

-- 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 Positional GeneralInstance
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
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
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 :: CategoryName -> [ParamName] -> CompiledData [String]
defineTypeName :: CategoryName -> [ParamName] -> CompiledData [String]
defineTypeName CategoryName
_ [ParamName]
ps =
  [String] -> CompiledData [String]
onlyCodes [
      String
"void BuildTypeName(std::ostream& output) const final {",
      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
");",
      String
"}"
    ]

declareGetCategory :: AnyCategory c -> [String]
declareGetCategory :: AnyCategory c -> [String]
declareGetCategory AnyCategory c
t = [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 -> [String]
defineGetCatetory :: AnyCategory c -> [String]
defineGetCatetory AnyCategory c
t = [
    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 -> [String]
declareGetType :: AnyCategory c -> [String]
declareGetType AnyCategory c
t = [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 -> [String]
defineGetType :: AnyCategory c -> [String]
defineGetType AnyCategory c
t = [
    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
"}"
  ]

defineInternalCategory :: AnyCategory c -> [String]
defineInternalCategory :: AnyCategory c -> [String]
defineInternalCategory AnyCategory c
t = [
    String
internal 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
internal String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"();",
    String
"  return category;",
    String
"}"
  ]
  where
    internal :: String
internal = CategoryName -> String
categoryName (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)

declareInternalType :: Monad m =>
  CategoryName -> Int -> m (CompiledData [String])
declareInternalType :: CategoryName -> Int -> m (CompiledData [String])
declareInternalType CategoryName
t Int
n =
  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
"S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator CategoryName
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 :: Monad m =>
  CategoryName -> Int -> m (CompiledData [String])
defineInternalType :: CategoryName -> Int -> m (CompiledData [String])
defineInternalType CategoryName
t Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 =
      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
"S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator CategoryName
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]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator CategoryName
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 =
      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
"S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeCreator CategoryName
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 WeakInstanceMap<" 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 CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">();",
        String
"  static auto& cache_mutex = *new std::mutex;",
        String
"  std::lock_guard<std::mutex> lock(cache_mutex);",
        String
"  auto& cached = cache[GetKeyFromParams<" 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
">(params)];",
        String
"  S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> type = cached;",
        String
"  if (!type) { cached = type = S_get(new " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
categoryCreator CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(), params)); }",
        String
"  return type;",
        String
"}"
      ]

declareInternalValue :: Monad m =>
  CategoryName -> Int -> Int -> m (CompiledData [String])
declareInternalValue :: CategoryName -> Int -> Int -> m (CompiledData [String])
declareInternalValue CategoryName
t Int
_ Int
_ =
  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
"S<TypeValue> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCreator CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"(S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> parent, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"const ParamTuple& params, const ValueTuple& args);"
    ]

defineInternalValue :: Monad m =>
  CategoryName -> Int -> Int -> m (CompiledData [String])
defineInternalValue :: CategoryName -> Int -> Int -> m (CompiledData [String])
defineInternalValue CategoryName
t Int
_ Int
_ =
  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
"S<TypeValue> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueCreator CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(S<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
typeName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> parent, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"const ParamTuple& params, const ValueTuple& args) {",
      String
"  return S_get(new " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
valueName CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(parent, params, args));",
      String
"}"
    ]

createMainCommon :: String -> CompiledData [String] -> [String]
createMainCommon :: String -> CompiledData [String] -> [String]
createMainCommon String
n (CompiledData Set CategoryName
req [String]
out) =
  [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
req [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"int main(int argc, const char** argv) {",
      String
"  SetSignalHandler();",
      String
"  ProgramArgv program_argv(argc, argv);",
      String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
startFunctionTracing String
n
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
out [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

createMainFile :: (Show c, CompileErrorM m) =>
  CategoryMap c -> ExprMap c -> CategoryName -> FunctionName -> m (Namespace,[String])
createMainFile :: CategoryMap c
-> ExprMap c
-> CategoryName
-> FunctionName
-> m (Namespace, [String])
createMainFile 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. CompileErrorM m => String -> m a -> m a
??> do
  CompiledData [String]
ca <- (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 (CategoryMap c
-> ExprMap c -> Expression c -> m (CompiledData [String])
forall c (m :: * -> *).
(Show c, CompileErrorM 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] -> [String]
createMainCommon String
"main" CompiledData [String]
ca
  ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CompileErrorM 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 -> Positional GeneralInstance -> TypeInstance
TypeInstance CategoryName
n ([GeneralInstance] -> Positional GeneralInstance
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) []

createTestFile :: (Show c, CompileErrorM m) =>
  CategoryMap c -> ExprMap c  -> Expression c -> m ([CategoryName],[String])
createTestFile :: CategoryMap c
-> ExprMap c -> Expression c -> m ([CategoryName], [String])
createTestFile CategoryMap c
tm ExprMap c
em Expression c
e = (String
"In the creation of the test binary procedure") String
-> m ([CategoryName], [String]) -> m ([CategoryName], [String])
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
??> do
  ca :: CompiledData [String]
ca@(CompiledData Set CategoryName
req [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 (CategoryMap c
-> ExprMap c -> Expression c -> m (CompiledData [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c
-> ExprMap c -> Expression c -> m (CompiledData [String])
compileMainProcedure CategoryMap c
tm ExprMap c
em Expression c
e)
  let file :: [String]
file = [String]
testsOnlySourceGuard [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> CompiledData [String] -> [String]
createMainCommon String
"test" CompiledData [String]
ca
  ([CategoryName], [String]) -> m ([CategoryName], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList Set CategoryName
req,[String]
file)

getCategoryMentions :: AnyCategory c -> [CategoryName]
getCategoryMentions :: AnyCategory c -> [CategoryName]
getCategoryMentions AnyCategory c
t = [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 Positional GeneralInstance
ps) = CategoryName
dCategoryName -> [CategoryName] -> [CategoryName]
forall a. a -> [a] -> [a]
:([GeneralInstance] -> [CategoryName]
fromGenerals ([GeneralInstance] -> [CategoryName])
-> [GeneralInstance] -> [CategoryName]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
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