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

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

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

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

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

{-# LANGUAGE Safe #-}

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 Types.Builtin
import Types.DefinedCategory
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


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 :: (Ord c, Show c, CollectErrorsM 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
  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 -> [AnyCategory c] -> m ()
forall (m :: * -> *) a a.
(CollectErrorsM m, Show a, Show a) =>
Map CategoryName [DefinedCategory a]
-> Set CategoryName -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory c]
dm Set CategoryName
extensions ([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)
  [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
forall c. CategoryMap c
defaultCategories [[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
tmTesting <- (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
tmPrivate         [[AnyCategory c]
ts0,[AnyCategory c]
ts1]
  let 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
  let 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
  let nsTesting :: Set Namespace
nsTesting = Set Namespace
nsPrivate
  [CxxOutput]
xxInterfaces <- ([[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
$ [m [CxxOutput]] -> m [[CxxOutput]]
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, 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 -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
False) ([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 -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
False) ([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 -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
True)  ([AnyCategory c] -> [AnyCategory c]
forall c. [AnyCategory c] -> [AnyCategory c]
onlyNativeInterfaces [AnyCategory c]
ts1)
  [CxxOutput]
xxPrivate <- ([[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
$ (PrivateSource c -> m [CxxOutput])
-> [PrivateSource c] -> m [[CxxOutput]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ((CategoryMap c, Set Namespace)
-> (CategoryMap c, Set Namespace)
-> PrivateSource c
-> m [CxxOutput]
forall (m :: * -> *).
CollectErrorsM m =>
(CategoryMap c, Set Namespace)
-> (CategoryMap c, Set Namespace)
-> PrivateSource c
-> m [CxxOutput]
compilePrivate (CategoryMap c
tmPrivate,Set Namespace
nsPrivate) (CategoryMap c
tmTesting,Set Namespace
nsTesting)) [PrivateSource c]
xa
  [CxxOutput]
xxStreamlined <- ([[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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryMap c -> CategoryName -> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CollectErrorsM m, Ord c) =>
CategoryMap c -> CategoryName -> m [CxxOutput]
streamlined CategoryMap c
tmTesting) ([CategoryName] -> m [[CxxOutput]])
-> [CategoryName] -> m [[CxxOutput]]
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> [CategoryName]
forall a. Eq a => [a] -> [a]
nub [CategoryName]
ss
  [CxxOutput]
xxVerbose <- ([[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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryMap c -> CategoryName -> m [CxxOutput]
forall (m :: * -> *) c.
(Show c, CollectErrorsM m, Ord c) =>
CategoryMap c -> CategoryName -> m [CxxOutput]
verbose CategoryMap c
tmTesting) ([CategoryName] -> m [[CxxOutput]])
-> [CategoryName] -> m [[CxxOutput]]
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> [CategoryName]
forall a. Eq a => [a] -> [a]
nub [CategoryName]
ex
  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 [CxxOutput] -> [CxxOutput] -> [CxxOutput]
forall a. [a] -> [a] -> [a]
++ [CxxOutput]
xxVerbose
  [([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 (m :: * -> *) a. Monad m => a -> m a
return [CxxOutput]
allFiles where
    extensions :: Set CategoryName
extensions = [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
$ [CategoryName]
ex [CategoryName] -> [CategoryName] -> [CategoryName]
forall a. [a] -> [a] -> [a]
++ [CategoryName]
ss
    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
    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]
ts1
    streamlined :: CategoryMap c -> CategoryName -> m [CxxOutput]
streamlined CategoryMap c
tm 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
      ([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)
      Bool -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> AnyCategory c -> m [CxxOutput]
generateStreamlinedExtension (CategoryName
n CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
testingCats) AnyCategory c
t
    verbose :: CategoryMap c -> CategoryName -> m [CxxOutput]
verbose CategoryMap c
tm 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
      ([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)
      Bool -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> AnyCategory c -> m [CxxOutput]
generateVerboseExtension (CategoryName
n CategoryName -> Set CategoryName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set CategoryName
testingCats) AnyCategory c
t
    compilePrivate :: (CategoryMap c, Set Namespace)
-> (CategoryMap c, Set Namespace)
-> PrivateSource c
-> m [CxxOutput]
compilePrivate (CategoryMap c
tmPrivate,Set Namespace
nsPrivate) (CategoryMap c
tmTesting,Set Namespace
nsTesting) (PrivateSource Namespace
ns3 Bool
testing [AnyCategory c]
cs2 [DefinedCategory c]
ds) = do
      let (CategoryMap c
tm,Set Namespace
ns) = if Bool
testing
                       then (CategoryMap c
tmTesting,Set Namespace
nsTesting)
                       else (CategoryMap c
tmPrivate,Set Namespace
nsPrivate)
      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]
ts1
                                                       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
ns) 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
$ CategoryMap c -> Set CategoryName
forall k a. Map k a -> Set k
Map.keysSet 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 -> [AnyCategory c] -> m ()
forall (m :: * -> *) a a.
(CollectErrorsM m, Show a, Show a) =>
Map CategoryName [DefinedCategory a]
-> Set CategoryName -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory c]
dm 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 (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 -> AnyCategory c -> m [CxxOutput]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool -> AnyCategory c -> m [CxxOutput]
generateNativeInterface Bool
testing) ((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 (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 (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
      CategoryMap c
tm' <- CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance CategoryMap c
tm DefinedCategory c
d
      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 (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]
ts1)
    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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
           Just [a]
c  ->
             [Char] -> m ()
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 -> [AnyCategory a] -> m ()
checkDefined Map CategoryName [DefinedCategory a]
dm Set CategoryName
ext = (AnyCategory a -> m ()) -> [AnyCategory a] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Map CategoryName [DefinedCategory a]
-> Set CategoryName -> AnyCategory a -> m ()
forall (m :: * -> *) a a.
(Show a, Show a, CollectErrorsM m) =>
Map CategoryName [DefinedCategory a]
-> Set CategoryName -> AnyCategory a -> m ()
checkSingle Map CategoryName [DefinedCategory a]
dm Set CategoryName
ext)
    checkSingle :: Map CategoryName [DefinedCategory a]
-> Set CategoryName -> AnyCategory a -> m ()
checkSingle Map CategoryName [DefinedCategory a]
dm Set CategoryName
ext 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
-> 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]) ->
             [Char] -> m ()
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
False,Maybe [DefinedCategory a]
Nothing) ->
             [Char] -> m ()
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
_,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 (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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
es2 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = [Char] -> m ()
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 (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 (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] -> [AnyCategory c] -> [DefinedCategory c] ->
  [TestProcedure c] -> m ([CxxOutput],CxxOutput,[(FunctionName,[c])])
compileTestsModule :: LanguageModule c
-> Namespace
-> [[Char]]
-> [AnyCategory c]
-> [DefinedCategory c]
-> [TestProcedure c]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
compileTestsModule LanguageModule c
cm Namespace
ns [[Char]]
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 :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
compileLanguageModule LanguageModule c
cm [PrivateSource c
xs]
  (CxxOutput
main,[(FunctionName, [c])]
fs) <- LanguageModule c
-> [[Char]]
-> PrivateSource c
-> [TestProcedure c]
-> m (CxxOutput, [(FunctionName, [c])])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> [[Char]]
-> PrivateSource c
-> [TestProcedure c]
-> m (CxxOutput, [(FunctionName, [c])])
compileTestMain LanguageModule c
cm [[Char]]
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 :: (Ord c, Show c, CollectErrorsM m) =>
  LanguageModule c -> [String] -> PrivateSource c -> [TestProcedure c] ->
  m (CxxOutput,[(FunctionName,[c])])
compileTestMain :: LanguageModule c
-> [[Char]]
-> 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) [[Char]]
args PrivateSource c
ts2 [TestProcedure c]
tests = do
  CategoryMap c
tm' <- m (CategoryMap c)
tm
  (CompiledData Set CategoryName
req [[Char]]
main) <- CategoryMap c
-> ExprMap c
-> [[Char]]
-> [TestProcedure c]
-> m (CompiledData [[Char]])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c
-> [[Char]]
-> [TestProcedure c]
-> m (CompiledData [[Char]])
generateTestFile CategoryMap c
tm' ExprMap c
em [[Char]]
args [TestProcedure c]
tests
  let output :: CxxOutput
output = Maybe CategoryName
-> [Char]
-> Namespace
-> Set Namespace
-> Set CategoryName
-> [[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 [[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
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, CollectErrorsM 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 :: (Ord c, Show c, CollectErrorsM 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.
(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 (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
-> [[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]) [[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
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 []  = [Char] -> m ()
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 (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