{- -----------------------------------------------------------------------------
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 CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}

module CompilerCxx.Category (
  CxxOutput(..),
  LanguageModule(..),
  PrivateSource(..),
  compileCategoryDeclaration,
  compileLanguageModule,
  compileConcreteDefinition,
  compileConcreteTemplate,
  compileInterfaceDefinition,
  compileModuleMain,
  compileTestsModule,
) 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

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

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 -> Set Namespace
coUsesNamespace :: Set.Set Namespace,
    CxxOutput -> Set CategoryName
coUsesCategory :: Set.Set CategoryName,
    CxxOutput -> [String]
coOutput :: [String]
  }
  deriving (Int -> CxxOutput -> ShowS
[CxxOutput] -> ShowS
CxxOutput -> String
(Int -> CxxOutput -> ShowS)
-> (CxxOutput -> String)
-> ([CxxOutput] -> ShowS)
-> Show CxxOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CxxOutput] -> ShowS
$cshowList :: [CxxOutput] -> ShowS
show :: CxxOutput -> String
$cshow :: CxxOutput -> String
showsPrec :: Int -> CxxOutput -> ShowS
$cshowsPrec :: Int -> CxxOutput -> ShowS
Show)

data LanguageModule c =
  LanguageModule {
    LanguageModule c -> Set Namespace
lmPublicNamespaces :: Set.Set Namespace,
    LanguageModule c -> Set Namespace
lmPrivateNamespaces :: Set.Set Namespace,
    LanguageModule c -> Set Namespace
lmLocalNamespaces :: Set.Set 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 Set Namespace
ns0 Set Namespace
ns1 Set 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)
-> Set Namespace
-> AnyCategory c
-> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CompileErrorM m) =>
Bool
-> m (CategoryMap c)
-> Set Namespace
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
False m (CategoryMap c)
tmPublic  Set 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)
-> Set Namespace
-> AnyCategory c
-> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CompileErrorM m) =>
Bool
-> m (CategoryMap c)
-> Set Namespace
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
False m (CategoryMap c)
tmPrivate Set 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)
-> Set Namespace
-> AnyCategory c
-> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CompileErrorM m) =>
Bool
-> m (CategoryMap c)
-> Set Namespace
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
True  m (CategoryMap c)
tmTesting Set 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 :: Set Namespace
nsPublic = Set Namespace
ns0 Set Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Namespace
ns2
    nsPrivate :: Set Namespace
nsPrivate = Set Namespace
ns1 Set Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Namespace
nsPublic
    nsTesting :: Set Namespace
nsTesting = Set Namespace
nsPrivate
    compileSourceP :: Bool
-> m (CategoryMap c)
-> Set Namespace
-> AnyCategory c
-> m [CxxOutput]
compileSourceP Bool
testing m (CategoryMap c)
tm Set Namespace
ns AnyCategory c
c = do
      CategoryMap c
tm' <- m (CategoryMap c)
tm
      CxxOutput
hxx <- Bool
-> CategoryMap c -> Set Namespace -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing CategoryMap c
tm' Set 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 :: Set Namespace
ns4 = if Bool
testing
                then Set Namespace
nsTesting
                else Set 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 -> Set Namespace -> AnyCategory c -> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing CategoryMap c
tm' Set 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
-> Set Namespace
-> DefinedCategory c
-> m CxxOutput
forall (m :: * -> *).
CompileErrorM m =>
Bool
-> CategoryMap c
-> Set Namespace
-> DefinedCategory c
-> m CxxOutput
compileDefinition Bool
testing CategoryMap c
tm' (Namespace
ns Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set 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
-> Set Namespace
-> DefinedCategory c
-> m CxxOutput
compileDefinition Bool
testing CategoryMap c
tm Set 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
-> Set Namespace
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c
-> ExprMap c
-> Set Namespace
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
compileConcreteDefinition Bool
testing CategoryMap c
tm' ExprMap c
em Set 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"

compileTestsModule :: (Show c, CompileErrorM m) =>
  LanguageModule c -> Namespace -> [String] -> [AnyCategory c] -> [DefinedCategory c] ->
  [TestProcedure c] -> m ([CxxOutput],CxxOutput,[(FunctionName,[c])])
compileTestsModule :: LanguageModule c
-> Namespace
-> [String]
-> [AnyCategory c]
-> [DefinedCategory c]
-> [TestProcedure c]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
compileTestsModule LanguageModule c
cm Namespace
ns [String]
args [AnyCategory c]
cs [DefinedCategory c]
ds [TestProcedure c]
ts = do
  let xs :: PrivateSource c
xs = PrivateSource :: forall c.
Namespace
-> Bool
-> [AnyCategory c]
-> [DefinedCategory c]
-> PrivateSource c
PrivateSource {
      psNamespace :: Namespace
psNamespace = Namespace
ns,
      psTesting :: Bool
psTesting = Bool
True,
      psCategory :: [AnyCategory c]
psCategory = [AnyCategory c]
cs,
      psDefine :: [DefinedCategory c]
psDefine = [DefinedCategory c]
ds
    }
  [CxxOutput]
xx <- LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
compileLanguageModule LanguageModule c
cm [PrivateSource c
xs]
  (CxxOutput
main,[(FunctionName, [c])]
fs) <- LanguageModule c
-> [String]
-> PrivateSource c
-> [TestProcedure c]
-> m (CxxOutput, [(FunctionName, [c])])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
LanguageModule c
-> [String]
-> PrivateSource c
-> [TestProcedure c]
-> m (CxxOutput, [(FunctionName, [c])])
compileTestMain LanguageModule c
cm [String]
args PrivateSource c
xs [TestProcedure c]
ts
  ([CxxOutput], CxxOutput, [(FunctionName, [c])])
-> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
forall (m :: * -> *) a. Monad m => a -> m a
return ([CxxOutput]
xx,CxxOutput
main,[(FunctionName, [c])]
fs)

compileTestMain :: (Show c, CompileErrorM m) =>
  LanguageModule c -> [String] -> PrivateSource c -> [TestProcedure c] ->
  m (CxxOutput,[(FunctionName,[c])])
compileTestMain :: LanguageModule c
-> [String]
-> PrivateSource c
-> [TestProcedure c]
-> m (CxxOutput, [(FunctionName, [c])])
compileTestMain (LanguageModule Set Namespace
ns0 Set Namespace
ns1 Set 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) [String]
args PrivateSource c
ts2 [TestProcedure c]
tests = do
  CategoryMap c
tm' <- m (CategoryMap c)
tm
  (CompiledData Set CategoryName
req [String]
main) <- CategoryMap c
-> ExprMap c
-> [String]
-> [TestProcedure c]
-> m (CompiledData [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c
-> ExprMap c
-> [String]
-> [TestProcedure c]
-> m (CompiledData [String])
createTestFile CategoryMap c
tm' ExprMap c
em [String]
args [TestProcedure c]
tests
  let output :: CxxOutput
output = Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set 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 -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` [Set Namespace] -> Set Namespace
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Namespace
ns0,Set Namespace
ns1,Set Namespace
ns2]) Set CategoryName
req [String]
main
  let tests' :: [(FunctionName, [c])]
tests' = (TestProcedure c -> (FunctionName, [c]))
-> [TestProcedure c] -> [(FunctionName, [c])]
forall a b. (a -> b) -> [a] -> [b]
map (\TestProcedure c
t -> (TestProcedure c -> FunctionName
forall c. TestProcedure c -> FunctionName
tpName TestProcedure c
t,TestProcedure c -> [c]
forall c. TestProcedure c -> [c]
tpContext TestProcedure c
t)) [TestProcedure c]
tests
  (CxxOutput, [(FunctionName, [c])])
-> m (CxxOutput, [(FunctionName, [c])])
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput
output,[(FunctionName, [c])]
tests') 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 Set Namespace
ns0 Set Namespace
ns1 Set 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
-> Set Namespace
-> Set CategoryName
-> [String]
-> CxxOutput
CxxOutput Maybe CategoryName
forall a. Maybe a
Nothing String
mainFilename Namespace
NoNamespace (Namespace
ns Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` [Set Namespace] -> Set Namespace
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Namespace
ns0,Set Namespace
ns1,Set Namespace
ns2]) ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [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 -> Set.Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration :: Bool
-> CategoryMap c -> Set Namespace -> AnyCategory c -> m CxxOutput
compileCategoryDeclaration Bool
testing CategoryMap c
_ Set Namespace
ns AnyCategory c
t =
  CxxOutput -> m CxxOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                     (CategoryName -> String
headerFilename CategoryName
name)
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                     (CompiledData [String] -> Set CategoryName
forall s. CompiledData s -> Set CategoryName
cdRequired CompiledData [String]
file)
                     (CompiledData [String] -> [String]
forall s. CompiledData s -> s
cdOutput CompiledData [String]
file) where
    file :: CompiledData [String]
file = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat ([CompiledData [String]] -> CompiledData [String])
-> [CompiledData [String]] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
        Set CategoryName -> [String] -> CompiledData [String]
forall s. Set CategoryName -> s -> CompiledData s
CompiledData Set CategoryName
depends [],
        [String] -> CompiledData [String]
onlyCodes [String]
guardTop,
        [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ (if Bool
testing then CategoryName -> [String]
testsOnlyCategoryGuard (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) else []),
        [String] -> CompiledData [String]
onlyCodes [String]
baseHeaderIncludes,
        AnyCategory c -> CompiledData [String] -> CompiledData [String]
forall c.
AnyCategory c -> CompiledData [String] -> CompiledData [String]
addNamespace AnyCategory c
t CompiledData [String]
content,
        [String] -> CompiledData [String]
onlyCodes [String]
guardBottom
      ]
    depends :: Set CategoryName
depends = AnyCategory c -> Set CategoryName
forall c. AnyCategory c -> Set CategoryName
getCategoryDeps AnyCategory c
t
    content :: CompiledData [String]
content = [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
-> Set Namespace
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
forall (m :: * -> *) c.
CompileErrorM m =>
Bool
-> AnyCategory c
-> Set Namespace
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
commonDefineAll Bool
testing AnyCategory c
t Set Namespace
forall a. Set a
Set.empty 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
-> Set Namespace
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Bool
-> CategoryMap c
-> ExprMap c
-> Set Namespace
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
compileConcreteDefinition Bool
testing CategoryMap c
ta ExprMap c
forall k a. Map k a
Map.empty Set Namespace
forall a. Set a
Set.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
-> Set Namespace
-> Set CategoryName
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                      (CategoryName -> String
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)
                      ([Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList [AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t])
                      ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName] -> Set CategoryName)
-> [CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [CategoryName]
forall c. AnyCategory c -> [CategoryName]
getCategoryMentions AnyCategory c
t)
                      [String]
guard
  let cxx :: CxxOutput
cxx = Maybe CategoryName
-> String
-> Namespace
-> Set Namespace
-> Set CategoryName
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                      (CategoryName -> String
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)
                      ([Namespace] -> Set Namespace
forall a. Ord a => [a] -> Set a
Set.fromList [AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t])
                      ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList ([CategoryName] -> Set CategoryName)
-> [CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ 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 -> Set.Set Namespace -> Maybe [ValueRefine c] ->
  DefinedCategory c -> m CxxOutput
compileConcreteDefinition :: Bool
-> CategoryMap c
-> ExprMap c
-> Set Namespace
-> Maybe [ValueRefine c]
-> DefinedCategory c
-> m CxxOutput
compileConcreteDefinition Bool
testing CategoryMap c
ta ExprMap c
em Set 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
-> Set Namespace
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
forall (m :: * -> *) c.
CompileErrorM m =>
Bool
-> AnyCategory c
-> Set Namespace
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
commonDefineAll Bool
testing AnyCategory c
t Set 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
$ CategoryName -> SymbolScope -> String
startInitTracing CategoryName
n SymbolScope
CategoryScope,
          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
$ CategoryName -> SymbolScope -> String
startInitTracing CategoryName
n SymbolScope
TypeScope,
          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 -> Set.Set Namespace -> Maybe [ValueRefine c] ->
  CompiledData [String] -> CompiledData [String] -> CompiledData [String] ->
  CompiledData [String] -> [ScopedFunction c] -> m CxxOutput
commonDefineAll :: Bool
-> AnyCategory c
-> Set Namespace
-> Maybe [ValueRefine c]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> CompiledData [String]
-> [ScopedFunction c]
-> m CxxOutput
commonDefineAll Bool
testing AnyCategory c
t Set 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
-> Set Namespace
-> Set CategoryName
-> [String]
-> CxxOutput
CxxOutput (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t)
                     String
filename
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t)
                     (AnyCategory c -> Namespace
forall c. AnyCategory c -> Namespace
getCategoryNamespace AnyCategory c
t Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
ns)
                     Set CategoryName
req
                     ([String]
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] -> CompiledData [String] -> [String]
createMainCommon :: String
-> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon String
n (CompiledData Set CategoryName
req0 [String]
out0) (CompiledData Set CategoryName
req1 [String]
out1) =
  [String]
baseSourceIncludes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
mainSourceIncludes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Set CategoryName -> [String]
depIncludes (Set CategoryName
req0 Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CategoryName
req1) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
out0 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"int main(int argc, const char** argv) {",
      String
"  SetSignalHandler();",
      String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> FunctionName -> String
startFunctionTracing CategoryName
CategoryNone (String -> FunctionName
FunctionName String
n)
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
out1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"] where
      depIncludes :: Set CategoryName -> [String]
depIncludes Set CategoryName
req2 = (CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\CategoryName
i -> String
"#include \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
headerFilename CategoryName
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"") ([CategoryName] -> [String]) -> [CategoryName] -> [String]
forall a b. (a -> b) -> a -> b
$
                           Set CategoryName -> [CategoryName]
forall a. Set a -> [a]
Set.toList Set CategoryName
req2

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 <- 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] -> CompiledData [String] -> [String]
createMainCommon String
"main" CompiledData [String]
emptyCode (CompiledData [String]
argv CompiledData [String]
-> CompiledData [String] -> CompiledData [String]
forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
ca)
  ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, 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) []
    argv :: CompiledData [String]
argv = String -> CompiledData [String]
onlyCode String
"ProgramArgv program_argv(argc, argv);"

createTestFile :: (Show c, CompileErrorM m) =>
  CategoryMap c -> ExprMap c  -> [String] -> [TestProcedure c] -> m (CompiledData [String])
createTestFile :: CategoryMap c
-> ExprMap c
-> [String]
-> [TestProcedure c]
-> m (CompiledData [String])
createTestFile CategoryMap c
tm ExprMap c
em [String]
args [TestProcedure c]
ts = String
"In the creation of the test binary procedure" String -> m (CompiledData [String]) -> m (CompiledData [String])
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
??> do
  CompiledData [String]
ts' <- ([CompiledData [String]] -> CompiledData [String])
-> m [CompiledData [String]] -> m (CompiledData [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat (m [CompiledData [String]] -> m (CompiledData [String]))
-> m [CompiledData [String]] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (TestProcedure c -> m (CompiledData [String]))
-> [TestProcedure c] -> m [CompiledData [String]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (CategoryMap c
-> ExprMap c -> TestProcedure c -> m (CompiledData [String])
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c
-> ExprMap c -> TestProcedure c -> m (CompiledData [String])
compileTestProcedure CategoryMap c
tm ExprMap c
em) [TestProcedure c]
ts
  ([String]
include,CompiledData [String]
sel) <- [FunctionName] -> m ([String], CompiledData [String])
forall (m :: * -> *).
CompileErrorM m =>
[FunctionName] -> m ([String], CompiledData [String])
selectTestFromArgv1 ([FunctionName] -> m ([String], CompiledData [String]))
-> [FunctionName] -> m ([String], CompiledData [String])
forall a b. (a -> b) -> a -> b
$ (TestProcedure c -> FunctionName)
-> [TestProcedure c] -> [FunctionName]
forall a b. (a -> b) -> [a] -> [b]
map TestProcedure c -> FunctionName
forall c. TestProcedure c -> FunctionName
tpName [TestProcedure c]
ts
  let (CompiledData Set CategoryName
req [String]
_) = CompiledData [String]
ts' CompiledData [String]
-> CompiledData [String] -> CompiledData [String]
forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
sel
  let file :: [String]
file = [String]
testsOnlySourceGuard [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
-> CompiledData [String] -> CompiledData [String] -> [String]
createMainCommon String
"testcase" ([String] -> CompiledData [String]
onlyCodes [String]
include CompiledData [String]
-> CompiledData [String] -> CompiledData [String]
forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
ts') (CompiledData [String]
argv CompiledData [String]
-> CompiledData [String] -> CompiledData [String]
forall a. Semigroup a => a -> a -> a
<> CompiledData [String]
sel)
  CompiledData [String] -> m (CompiledData [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ Set CategoryName -> [String] -> CompiledData [String]
forall s. Set CategoryName -> s -> CompiledData s
CompiledData Set CategoryName
req [String]
file where
    args' :: [String]
args' = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
escapeChars [String]
args
    argv :: CompiledData [String]
argv = [String] -> CompiledData [String]
onlyCodes [
        String
"const char* argv2[] = { \"testcase\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
args') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" };",
        String
"ProgramArgv program_argv(sizeof argv2 / sizeof(char*), argv2);"
      ]

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