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

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

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

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

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

module CompilerCxx.LanguageModule (
  LanguageModule(..),
  PrivateSource(..),
  compileLanguageModule,
  compileModuleMain,
  compileTestsModule,
) where

import Control.Monad (foldM,foldM_,when)
import Data.List (intercalate,nub)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Compilation.CompilerState
import Compilation.ProcedureContext (ExprMap)
import CompilerCxx.CxxFiles
import CompilerCxx.Naming
import Module.CompileMetadata (CategorySpec(..))
import Types.DefinedCategory
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


data LanguageModule c =
  LanguageModule {
    forall c. LanguageModule c -> Set Namespace
lmPublicNamespaces :: Set.Set Namespace,
    forall c. LanguageModule c -> Set Namespace
lmPrivateNamespaces :: Set.Set Namespace,
    forall c. LanguageModule c -> Set Namespace
lmLocalNamespaces :: Set.Set Namespace,
    forall c. LanguageModule c -> [AnyCategory c]
lmPublicDeps :: [AnyCategory c],
    forall c. LanguageModule c -> [AnyCategory c]
lmPrivateDeps :: [AnyCategory c],
    forall c. LanguageModule c -> [AnyCategory c]
lmPublicTestingDeps :: [AnyCategory c],
    forall c. LanguageModule c -> [AnyCategory c]
lmPrivateTestingDeps :: [AnyCategory c],
    forall c. LanguageModule c -> [AnyCategory c]
lmPublicLocal :: [AnyCategory c],
    forall c. LanguageModule c -> [AnyCategory c]
lmPrivateLocal :: [AnyCategory c],
    forall c. LanguageModule c -> [AnyCategory c]
lmPublicTestingLocal :: [AnyCategory c],
    forall c. LanguageModule c -> [AnyCategory c]
lmPrivateTestingLocal :: [AnyCategory c],
    forall c. LanguageModule c -> [CategoryName]
lmStreamlined :: [CategoryName],
    forall c. LanguageModule c -> ExprMap c
lmExprMap :: ExprMap c,
    forall c. LanguageModule c -> CategoryMap c
lmEmptyCategories :: CategoryMap c
  }

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

compileLanguageModule :: (Ord c, Show c, CollectErrorsM m) =>
  LanguageModule c -> Map.Map CategoryName (CategorySpec c) ->
  [PrivateSource c] -> m [CxxOutput]
compileLanguageModule :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> Map CategoryName (CategorySpec c)
-> [PrivateSource c]
-> m [CxxOutput]
compileLanguageModule (LanguageModule Set Namespace
ns0 Set Namespace
ns1 Set Namespace
ns2 [AnyCategory c]
cs0 [AnyCategory c]
ps0 [AnyCategory c]
tc0 [AnyCategory c]
tp0 [AnyCategory c]
cs1 [AnyCategory c]
ps1 [AnyCategory c]
tc1 [AnyCategory c]
tp1 [CategoryName]
ss ExprMap c
em CategoryMap c
cm0) Map CategoryName (CategorySpec c)
sm [PrivateSource c]
xa = do
  let dm :: Map CategoryName [DefinedCategory c]
dm = [DefinedCategory c] -> Map CategoryName [DefinedCategory c]
forall {c}.
[DefinedCategory c] -> Map CategoryName [DefinedCategory c]
mapDefByName ([DefinedCategory c] -> Map CategoryName [DefinedCategory c])
-> [DefinedCategory c] -> Map CategoryName [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]
xa
  Map CategoryName [DefinedCategory c]
-> Set CategoryName -> Set CategoryName -> [AnyCategory c] -> m ()
forall {m :: * -> *} {a} {a}.
(CollectErrorsM m, Show a, Show a) =>
Map CategoryName [DefinedCategory a]
-> Set CategoryName -> Set CategoryName -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory c]
dm Set CategoryName
extensions Set CategoryName
allExternal ([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]
tc1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
tp1)
  [CategoryName] -> m ()
forall {m :: * -> *} {a}. (ErrorContextM 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
$ Set CategoryName
extensions Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set CategoryName
ca
  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, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
cm0             [[AnyCategory c]
cs0,[AnyCategory c]
cs1]
  CategoryMap c
tmPrivate        <- (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, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tmPublic        [[AnyCategory c]
ps0,[AnyCategory c]
ps1]
  CategoryMap c
tmPublicTesting  <- (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, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tmPublic        [[AnyCategory c]
tc0,[AnyCategory c]
tc1]
  CategoryMap c
tmPrivateTesting <- (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, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tmPublicTesting [[AnyCategory c]
ps0,[AnyCategory c]
tp0,[AnyCategory c]
ps1,[AnyCategory c]
tp1]
  [CxxOutput]
xxInterfaces <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[CxxOutput]] -> m [CxxOutput])
-> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ [m [CxxOutput]] -> m [[CxxOutput]]
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m [a]
forall (f :: * -> *) a. Foldable f => f (m a) -> m [a]
collectAllM ([m [CxxOutput]] -> m [[CxxOutput]])
-> [m [CxxOutput]] -> m [[CxxOutput]]
forall a b. (a -> b) -> a -> b
$
    (AnyCategory c -> m [CxxOutput])
-> [AnyCategory c] -> [m [CxxOutput]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
False Set Namespace
nsPublic)  ([AnyCategory c] -> [AnyCategory c]
forall {c}. [AnyCategory c] -> [AnyCategory c]
onlyNativeInterfaces [AnyCategory c]
cs1) [m [CxxOutput]] -> [m [CxxOutput]] -> [m [CxxOutput]]
forall a. [a] -> [a] -> [a]
++
    (AnyCategory c -> m [CxxOutput])
-> [AnyCategory c] -> [m [CxxOutput]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
False Set Namespace
nsPrivate) ([AnyCategory c] -> [AnyCategory c]
forall {c}. [AnyCategory c] -> [AnyCategory c]
onlyNativeInterfaces [AnyCategory c]
ps1) [m [CxxOutput]] -> [m [CxxOutput]] -> [m [CxxOutput]]
forall a. [a] -> [a] -> [a]
++
    (AnyCategory c -> m [CxxOutput])
-> [AnyCategory c] -> [m [CxxOutput]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
True  Set Namespace
nsPublic)  ([AnyCategory c] -> [AnyCategory c]
forall {c}. [AnyCategory c] -> [AnyCategory c]
onlyNativeInterfaces [AnyCategory c]
tc1) [m [CxxOutput]] -> [m [CxxOutput]] -> [m [CxxOutput]]
forall a. [a] -> [a] -> [a]
++
    (AnyCategory c -> m [CxxOutput])
-> [AnyCategory c] -> [m [CxxOutput]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
True  Set Namespace
nsPrivate) ([AnyCategory c] -> [AnyCategory c]
forall {c}. [AnyCategory c] -> [AnyCategory c]
onlyNativeInterfaces [AnyCategory c]
tp1)
  [CxxOutput]
xxPrivate <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[CxxOutput]] -> m [CxxOutput])
-> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ (PrivateSource c -> m [CxxOutput])
-> [PrivateSource c] -> m [[CxxOutput]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryMap c -> CategoryMap c -> PrivateSource c -> m [CxxOutput]
forall {m :: * -> *}.
CollectErrorsM m =>
CategoryMap c -> CategoryMap c -> PrivateSource c -> m [CxxOutput]
compilePrivate CategoryMap c
tmPrivate CategoryMap c
tmPrivateTesting) [PrivateSource c]
xa
  [CxxOutput]
xxStreamlined <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryMap c -> CategoryMap c -> CategoryName -> m [CxxOutput]
forall {m :: * -> *}.
CollectErrorsM m =>
CategoryMap c -> CategoryMap c -> CategoryName -> m [CxxOutput]
streamlined CategoryMap c
tmPrivate CategoryMap c
tmPrivateTesting) ([CategoryName] -> m [[CxxOutput]])
-> [CategoryName] -> m [[CxxOutput]]
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> [CategoryName]
forall a. Eq a => [a] -> [a]
nub [CategoryName]
ss
  let allFiles :: [CxxOutput]
allFiles = [CxxOutput]
xxInterfaces [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xxPrivate [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xxStreamlined
  [([Char], Namespace)] -> m ()
noDuplicateFiles ([([Char], Namespace)] -> m ()) -> [([Char], Namespace)] -> m ()
forall a b. (a -> b) -> a -> b
$ (CxxOutput -> ([Char], Namespace))
-> [CxxOutput] -> [([Char], Namespace)]
forall a b. (a -> b) -> [a] -> [b]
map (\CxxOutput
f -> (CxxOutput -> [Char]
coFilename CxxOutput
f,CxxOutput -> Namespace
coNamespace CxxOutput
f)) [CxxOutput]
allFiles
  [CxxOutput] -> m [CxxOutput]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [CxxOutput]
allFiles where
    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
    extensions :: Set CategoryName
extensions = [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName]
ss
    allExternal :: Set CategoryName
allExternal = [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName
extensions,Map CategoryName (CategorySpec c) -> Set CategoryName
forall k a. Map k a -> Set k
Map.keysSet Map CategoryName (CategorySpec c)
sm]
    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]
tc1) [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]
tp1)
    onlyNativeInterfaces :: [AnyCategory c] -> [AnyCategory c]
onlyNativeInterfaces = (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
. (CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
extensions) (CategoryName -> Bool)
-> (AnyCategory c -> CategoryName) -> AnyCategory c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName) ([AnyCategory c] -> [AnyCategory c])
-> ([AnyCategory c] -> [AnyCategory c])
-> [AnyCategory c]
-> [AnyCategory c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
    localCats :: Set CategoryName
localCats = [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]
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]
tc1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
tp1
    streamlined :: CategoryMap c -> CategoryMap c -> CategoryName -> m [CxxOutput]
streamlined CategoryMap c
tm0 CategoryMap c
tm2 CategoryName
n = do
      Set CategoryName -> [[Char]] -> CategoryName -> m ()
forall {f :: * -> *} {a} {a}.
(Ord a, ErrorContextM f, Show a, Show a) =>
Set a -> [a] -> a -> f ()
checkLocal Set CategoryName
localCats ([] :: [String]) CategoryName
n
      let testing :: Bool
testing = CategoryName
n CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
testingCats
      let tm :: CategoryMap c
tm = if Bool
testing then CategoryMap c
tm2 else CategoryMap c
tm0
      ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
tm ([],CategoryName
n)
      let ctx :: FileContext c
ctx = Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
forall c.
Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
FileContext Bool
testing CategoryMap c
tm Set Namespace
nsPrivate ExprMap c
forall k a. Map k a
Map.empty
      let spec :: CategorySpec c
spec = CategorySpec c
-> CategoryName
-> Map CategoryName (CategorySpec c)
-> CategorySpec c
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ([c] -> [ValueRefine c] -> [ValueDefine c] -> CategorySpec c
forall c.
[c] -> [ValueRefine c] -> [ValueDefine c] -> CategorySpec c
CategorySpec [] [] []) (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) Map CategoryName (CategorySpec c)
sm
      FileContext c -> AnyCategory c -> CategorySpec c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
FileContext c -> AnyCategory c -> CategorySpec c -> m [CxxOutput]
generateStreamlinedExtension FileContext c
ctx AnyCategory c
t CategorySpec c
spec
    compilePrivate :: CategoryMap c -> CategoryMap c -> PrivateSource c -> m [CxxOutput]
compilePrivate CategoryMap c
tmPrivate CategoryMap c
tmTesting (PrivateSource Namespace
ns3 Bool
testing [AnyCategory c]
cs2 [DefinedCategory c]
ds) = do
      let tm :: CategoryMap c
tm = if Bool
testing
                  then CategoryMap c
tmTesting
                  else CategoryMap c
tmPrivate
      let cs :: Set CategoryName
cs = [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
$ if Bool
testing
                                                       then [AnyCategory c]
cs2 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [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]
tc1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
tp1
                                                       else [AnyCategory c]
cs2 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
cs1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
ps1
      CategoryMap c
tm' <- CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tm [AnyCategory c]
cs2
      let ctx :: FileContext c
ctx = Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
forall c.
Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
FileContext Bool
testing CategoryMap c
tm' (Namespace
ns3 Namespace -> Set Namespace -> Set Namespace
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set Namespace
nsPrivate) ExprMap c
em
      [DefinedCategory c] -> Set CategoryName -> m ()
forall {m :: * -> *} {c}.
(CollectErrorsM m, Show c) =>
[DefinedCategory c] -> Set CategoryName -> m ()
checkLocals [DefinedCategory c]
ds (Set CategoryName -> m ()) -> Set CategoryName -> m ()
forall a b. (a -> b) -> a -> b
$ Map CategoryName (AnyCategory c) -> Set CategoryName
forall k a. Map k a -> Set k
Map.keysSet (Map CategoryName (AnyCategory c) -> Set CategoryName)
-> Map CategoryName (AnyCategory c) -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ CategoryMap c -> Map CategoryName (AnyCategory c)
forall c. CategoryMap c -> Map CategoryName (AnyCategory c)
cmAvailable CategoryMap c
tm'
      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}.
(CollectErrorsM 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]
mapDefByName [DefinedCategory c]
ds
      Map CategoryName [DefinedCategory c]
-> Set CategoryName -> Set CategoryName -> [AnyCategory c] -> m ()
forall {m :: * -> *} {a} {a}.
(CollectErrorsM m, Show a, Show a) =>
Map CategoryName [DefinedCategory a]
-> Set CategoryName -> Set CategoryName -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory c]
dm Set CategoryName
forall a. Set a
Set.empty Set CategoryName
forall a. Set a
Set.empty ([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
      [CxxOutput]
xxInterfaces <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> Set Namespace -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
testing Set Namespace
nsPrivate) ((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]
xxConcrete   <- ([[CxxOutput]] -> [CxxOutput]) -> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[CxxOutput]] -> [CxxOutput]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[CxxOutput]] -> m [CxxOutput])
-> m [[CxxOutput]] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ (DefinedCategory c -> m [CxxOutput])
-> [DefinedCategory c] -> m [[CxxOutput]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (Set CategoryName
-> FileContext c -> DefinedCategory c -> m [CxxOutput]
forall {m :: * -> *} {c}.
(Show c, CollectErrorsM m, Ord c) =>
Set CategoryName
-> FileContext c -> DefinedCategory c -> m [CxxOutput]
generateConcrete Set CategoryName
cs FileContext c
ctx) [DefinedCategory c]
ds
      [CxxOutput] -> m [CxxOutput]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CxxOutput] -> m [CxxOutput]) -> [CxxOutput] -> m [CxxOutput]
forall a b. (a -> b) -> a -> b
$ [CxxOutput]
xxInterfaces [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xxConcrete
    generateConcrete :: Set CategoryName
-> FileContext c -> DefinedCategory c -> m [CxxOutput]
generateConcrete Set CategoryName
cs (FileContext Bool
testing CategoryMap c
tm Set Namespace
ns ExprMap c
em2) DefinedCategory c
d = do
      AnyCategory c
t <- Set CategoryName
-> CategoryMap c -> DefinedCategory c -> m (AnyCategory c)
forall {m :: * -> *} {c}.
(Show c, CollectErrorsM m) =>
Set CategoryName
-> CategoryMap c -> DefinedCategory c -> m (AnyCategory c)
getCategoryDecl Set CategoryName
cs CategoryMap c
tm DefinedCategory c
d
      let ctx :: FileContext c
ctx = Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
forall c.
Bool
-> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
FileContext Bool
testing CategoryMap c
tm Set Namespace
ns ExprMap c
em2
      FileContext c
-> (AnyCategory c, DefinedCategory c) -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
FileContext c
-> (AnyCategory c, DefinedCategory c) -> m [CxxOutput]
generateNativeConcrete FileContext c
ctx (AnyCategory c
t,DefinedCategory c
d)
    getCategoryDecl :: Set CategoryName
-> CategoryMap c -> DefinedCategory c -> m (AnyCategory c)
getCategoryDecl Set CategoryName
cs CategoryMap c
tm DefinedCategory c
d = do
      Set CategoryName -> [c] -> CategoryName -> m ()
forall {f :: * -> *} {a} {a}.
(Ord a, ErrorContextM f, Show a, Show a) =>
Set a -> [a] -> a -> f ()
checkLocal Set CategoryName
cs (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d)
      (([c], AnyCategory c) -> AnyCategory c)
-> m ([c], AnyCategory c) -> m (AnyCategory c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([c], AnyCategory c) -> AnyCategory c
forall a b. (a, b) -> b
snd (m ([c], AnyCategory c) -> m (AnyCategory c))
-> m ([c], AnyCategory c) -> m (AnyCategory c)
forall a b. (a -> b) -> a -> b
$ CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
tm (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d,DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d)
    mapDefByName :: [DefinedCategory c] -> Map CategoryName [DefinedCategory c]
mapDefByName = ([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]
tc1 [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c]
forall a. [a] -> [a] -> [a]
++ [AnyCategory c]
tp1)
    checkLocals :: [DefinedCategory c] -> Set CategoryName -> m ()
checkLocals [DefinedCategory c]
ds Set CategoryName
tm = (DefinedCategory c -> m ()) -> [DefinedCategory c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\DefinedCategory c
d -> Set CategoryName -> [c] -> CategoryName -> m ()
forall {f :: * -> *} {a} {a}.
(Ord a, ErrorContextM f, Show a, Show a) =>
Set a -> [a] -> a -> f ()
checkLocal Set CategoryName
tm (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d)) [DefinedCategory c]
ds
    checkLocal :: Set a -> [a] -> a -> f ()
checkLocal Set a
cs2 [a]
c a
n =
      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
$ a
n a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
cs2) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> f ()
forall a. [Char] -> f a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char]
"Category " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                        [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace [a]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                        [Char]
" 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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Map CategoryName [a] -> DefinedCategory a -> m ()
forall {m :: * -> *} {a} {a}.
(ErrorContextM 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Just [a]
c  ->
             [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char]
"Category " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CategoryName -> [Char]
forall a. Show a => a -> [Char]
show (DefinedCategory a -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory a
d) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                            [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                            [Char]
" was not declared as $TestsOnly$" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace [a]
c)
    checkDefined :: Map CategoryName [DefinedCategory a]
-> Set CategoryName -> Set CategoryName -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory a]
dm Set CategoryName
ext Set CategoryName
extAll = (AnyCategory a -> m ()) -> [AnyCategory a] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Map CategoryName [DefinedCategory a]
-> Set CategoryName -> Set CategoryName -> AnyCategory a -> m ()
forall {m :: * -> *} {a} {a}.
(Show a, Show a, CollectErrorsM m) =>
Map CategoryName [DefinedCategory a]
-> Set CategoryName -> Set CategoryName -> AnyCategory a -> m ()
checkSingle Map CategoryName [DefinedCategory a]
dm Set CategoryName
ext Set CategoryName
extAll)
    checkSingle :: Map CategoryName [DefinedCategory a]
-> Set CategoryName -> Set CategoryName -> AnyCategory a -> m ()
checkSingle Map CategoryName [DefinedCategory a]
dm Set CategoryName
ext Set CategoryName
extAll 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
ext,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
extAll,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,Bool
False,Just [DefinedCategory a
_]) -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           (Bool
True,Bool
_,Maybe [DefinedCategory a]
Nothing) -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           (Bool
False,Bool
_,Maybe [DefinedCategory a]
Nothing) ->
             [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char]
"Category " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CategoryName -> [Char]
forall a. Show a => a -> [Char]
show (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace (AnyCategory a -> [a]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory a
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
" has not been defined or declared external")
           (Bool
_,Bool
True,Just [DefinedCategory a
d]) ->
             [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char]
"Category " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CategoryName -> [Char]
forall a. Show a => a -> [Char]
show (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace (AnyCategory a -> [a]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory a
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                             [Char]
" was declared external but is also defined at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContext (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d))
           (Bool
_,Bool
_,Just [DefinedCategory a]
ds) ->
             ([Char]
"Category " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CategoryName -> [Char]
forall a. Show a => a -> [Char]
show (AnyCategory a -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory a
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace (AnyCategory a -> [a]
forall c. AnyCategory c -> [c]
getCategoryContext AnyCategory a
t) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
" is defined " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([DefinedCategory a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DefinedCategory a]
ds) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" times") [Char] -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a -> m a
!!>
                (DefinedCategory a -> m Any) -> [DefinedCategory a] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\DefinedCategory a
d -> [Char] -> m Any
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char] -> m Any) -> [Char] -> m Any
forall a b. (a -> b) -> a -> b
$ [Char]
"Defined at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
es2 = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"External categories either not concrete or not present: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                     [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Show a => a -> [Char]
show [a]
es2)
    noDuplicateFiles :: [([Char], Namespace)] -> m ()
noDuplicateFiles = (Set ([Char], Namespace)
 -> ([Char], Namespace) -> m (Set ([Char], Namespace)))
-> Set ([Char], Namespace) -> [([Char], Namespace)] -> m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Set ([Char], Namespace)
-> ([Char], Namespace) -> m (Set ([Char], Namespace))
forall {m :: * -> *} {b}.
(Ord b, ErrorContextM m, Show b) =>
Set ([Char], b) -> ([Char], b) -> m (Set ([Char], b))
checkFileUsed Set ([Char], Namespace)
forall a. Set a
Set.empty
    checkFileUsed :: Set ([Char], b) -> ([Char], b) -> m (Set ([Char], b))
checkFileUsed Set ([Char], b)
used ([Char]
f,b
ns3) = do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (([Char]
f,b
ns3) ([Char], b) -> Set ([Char], b) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ([Char], b)
used) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Filename " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in namespace " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ b -> [Char]
forall a. Show a => a -> [Char]
show b
ns3 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                         [Char]
" was already generated (internal compiler error)"
      Set ([Char], b) -> m (Set ([Char], b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ([Char], b) -> m (Set ([Char], b)))
-> Set ([Char], b) -> m (Set ([Char], b))
forall a b. (a -> b) -> a -> b
$ ([Char]
f,b
ns3) ([Char], b) -> Set ([Char], b) -> Set ([Char], b)
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set ([Char], b)
used

compileTestsModule :: (Ord c, Show c, CollectErrorsM m) =>
  LanguageModule c -> Namespace -> [String] -> Maybe ([c],TypeInstance) -> [AnyCategory c] ->
  [DefinedCategory c] -> [TestProcedure c] -> m ([CxxOutput],CxxOutput,[(FunctionName,[c])])
compileTestsModule :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> Namespace
-> [[Char]]
-> Maybe ([c], TypeInstance)
-> [AnyCategory c]
-> [DefinedCategory c]
-> [TestProcedure c]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
compileTestsModule LanguageModule c
cm Namespace
ns [[Char]]
args Maybe ([c], TypeInstance)
t [AnyCategory c]
cs [DefinedCategory c]
ds [TestProcedure c]
ts = do
  let xs :: PrivateSource c
xs = 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
-> Map CategoryName (CategorySpec c)
-> [PrivateSource c]
-> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> Map CategoryName (CategorySpec c)
-> [PrivateSource c]
-> m [CxxOutput]
compileLanguageModule LanguageModule c
cm Map CategoryName (CategorySpec c)
forall k a. Map k a
Map.empty [PrivateSource c
xs]
  (CxxOutput
main,[(FunctionName, [c])]
fs) <- LanguageModule c
-> [[Char]]
-> Maybe ([c], TypeInstance)
-> PrivateSource c
-> [TestProcedure c]
-> m (CxxOutput, [(FunctionName, [c])])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> [[Char]]
-> Maybe ([c], TypeInstance)
-> PrivateSource c
-> [TestProcedure c]
-> m (CxxOutput, [(FunctionName, [c])])
compileTestMain LanguageModule c
cm [[Char]]
args Maybe ([c], TypeInstance)
t PrivateSource c
xs [TestProcedure c]
ts
  ([CxxOutput], CxxOutput, [(FunctionName, [c])])
-> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CxxOutput]
xx,CxxOutput
main,[(FunctionName, [c])]
fs)

compileTestMain :: (Ord c, Show c, CollectErrorsM m) =>
  LanguageModule c -> [String] -> Maybe ([c],TypeInstance) -> PrivateSource c -> [TestProcedure c] ->
  m (CxxOutput,[(FunctionName,[c])])
compileTestMain :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> [[Char]]
-> Maybe ([c], TypeInstance)
-> 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]
tc0 [AnyCategory c]
tp0 [AnyCategory c]
cs1 [AnyCategory c]
ps1 [AnyCategory c]
tc1 [AnyCategory c]
tp1 [CategoryName]
_ ExprMap c
em CategoryMap c
cm0) [[Char]]
args Maybe ([c], TypeInstance)
t PrivateSource c
ts2 [TestProcedure c]
tests = do
  CategoryMap c
tm' <- m (CategoryMap c)
tm
  (CompiledData Set CategoryName
req Set [Char]
traces [[Char]]
main) <- CategoryMap c
-> ExprMap c
-> [[Char]]
-> Maybe ([c], TypeInstance)
-> [TestProcedure c]
-> m (CompiledData [[Char]])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c
-> [[Char]]
-> Maybe ([c], TypeInstance)
-> [TestProcedure c]
-> m (CompiledData [[Char]])
generateTestFile CategoryMap c
tm' ExprMap c
em [[Char]]
args Maybe ([c], TypeInstance)
t [TestProcedure c]
tests
  let output :: CxxOutput
output = Maybe CategoryName
-> [Char]
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set [Char]
-> [[Char]]
-> CxxOutput
CxxOutput Maybe CategoryName
forall a. Maybe a
Nothing [Char]
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 Set [Char]
traces [[Char]]
main
  let tests' :: [(FunctionName, [c])]
tests' = (TestProcedure c -> (FunctionName, [c]))
-> [TestProcedure c] -> [(FunctionName, [c])]
forall a b. (a -> b) -> [a] -> [b]
map (\TestProcedure c
t2 -> (TestProcedure c -> FunctionName
forall c. TestProcedure c -> FunctionName
tpName TestProcedure c
t2,TestProcedure c -> [c]
forall c. TestProcedure c -> [c]
tpContext TestProcedure c
t2)) [TestProcedure c]
tests
  (CxxOutput, [(FunctionName, [c])])
-> m (CxxOutput, [(FunctionName, [c])])
forall a. a -> m a
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, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
cm0 [[AnyCategory c]
cs0,[AnyCategory c]
cs1,[AnyCategory c]
ps0,[AnyCategory c]
ps1,[AnyCategory c]
tc0,[AnyCategory c]
tp0,[AnyCategory c]
tc1,[AnyCategory c]
tp1,PrivateSource c -> [AnyCategory c]
forall c. PrivateSource c -> [AnyCategory c]
psCategory PrivateSource c
ts2]

compileModuleMain :: (Ord c, Show c, CollectErrorsM m) =>
  LanguageModule c -> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput
compileModuleMain :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
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]
_ [AnyCategory c]
cs1 [AnyCategory c]
ps1 [AnyCategory c]
_ [AnyCategory c]
_ [CategoryName]
_ ExprMap c
em CategoryMap c
cm0) [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}.
(CollectErrorsM 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, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
tm' [AnyCategory c]
cs
  (Namespace
ns,[[Char]]
main) <- CategoryMap c
-> ExprMap c
-> CategoryName
-> FunctionName
-> m (Namespace, [[Char]])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c
-> CategoryName
-> FunctionName
-> m (Namespace, [[Char]])
generateMainFile CategoryMap c
tm'' ExprMap c
em CategoryName
n FunctionName
f
  CxxOutput -> m CxxOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxxOutput -> m CxxOutput) -> CxxOutput -> m CxxOutput
forall a b. (a -> b) -> a -> b
$ Maybe CategoryName
-> [Char]
-> Namespace
-> Set Namespace
-> Set CategoryName
-> Set [Char]
-> [[Char]]
-> CxxOutput
CxxOutput Maybe CategoryName
forall a. Maybe a
Nothing [Char]
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]) Set [Char]
forall a. Set a
Set.empty [[Char]]
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, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m (CategoryMap c)
includeNewTypes CategoryMap c
cm0 [[AnyCategory c]
cs0,[AnyCategory c]
cs1,[AnyCategory c]
ps0,[AnyCategory c]
ps1]
    reconcile :: [DefinedCategory a] -> m ()
reconcile [DefinedCategory a
_] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    reconcile []  = [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"No matches for main category " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CategoryName -> [Char]
forall a. Show a => a -> [Char]
show CategoryName
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ($TestsOnly$ sources excluded)"
    reconcile [DefinedCategory a]
ds  =
      [Char]
"Multiple matches for main category " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CategoryName -> [Char]
forall a. Show a => a -> [Char]
show CategoryName
n [Char] -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a -> m a
!!>
        (DefinedCategory a -> m Any) -> [DefinedCategory a] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\DefinedCategory a
d -> [Char] -> m Any
forall a. [Char] -> m a
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char] -> m Any) -> [Char] -> m Any
forall a b. (a -> b) -> a -> b
$ [Char]
"Defined at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContext (DefinedCategory a -> [a]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory a
d)) [DefinedCategory a]
ds