{- -----------------------------------------------------------------------------
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]

{-# LANGUAGE Safe #-}

module Types.DefinedCategory (
  DefinedCategory(..),
  DefinedMember(..),
  PragmaDefined(..),
  VariableRule(..),
  VariableValue(..),
  isInitialized,
  isFlatCleanup,
  isMembersHidden,
  isMembersReadOnly,
  isMembersReadOnlyExcept,
  mapMembers,
  mergeInternalInheritance,
  pairProceduresToFunctions,
  replaceSelfMember,
  setInternalFunctions,
) where

import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.GeneralType
import Base.Positional
import Types.Function
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance
import Types.Variance


data DefinedCategory c =
  DefinedCategory {
    forall c. DefinedCategory c -> [c]
dcContext :: [c],
    forall c. DefinedCategory c -> CategoryName
dcName :: CategoryName,
    forall c. DefinedCategory c -> [PragmaDefined c]
dcPragmas :: [PragmaDefined c],
    forall c. DefinedCategory c -> [ValueRefine c]
dcRefines :: [ValueRefine c],
    forall c. DefinedCategory c -> [ValueDefine c]
dcDefines :: [ValueDefine c],
    forall c. DefinedCategory c -> [DefinedMember c]
dcMembers :: [DefinedMember c],
    forall c. DefinedCategory c -> [ExecutableProcedure c]
dcProcedures :: [ExecutableProcedure c],
    forall c. DefinedCategory c -> [ScopedFunction c]
dcFunctions :: [ScopedFunction c]
  }
  deriving (Int -> DefinedCategory c -> ShowS
[DefinedCategory c] -> ShowS
DefinedCategory c -> String
(Int -> DefinedCategory c -> ShowS)
-> (DefinedCategory c -> String)
-> ([DefinedCategory c] -> ShowS)
-> Show (DefinedCategory c)
forall c. Show c => Int -> DefinedCategory c -> ShowS
forall c. Show c => [DefinedCategory c] -> ShowS
forall c. Show c => DefinedCategory c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> DefinedCategory c -> ShowS
showsPrec :: Int -> DefinedCategory c -> ShowS
$cshow :: forall c. Show c => DefinedCategory c -> String
show :: DefinedCategory c -> String
$cshowList :: forall c. Show c => [DefinedCategory c] -> ShowS
showList :: [DefinedCategory c] -> ShowS
Show) -- TODO: Implement Show.

data DefinedMember c =
  DefinedMember {
    forall c. DefinedMember c -> [c]
dmContext :: [c],
    forall c. DefinedMember c -> SymbolScope
dmScope :: SymbolScope,
    forall c. DefinedMember c -> ValueType
dmType :: ValueType,
    forall c. DefinedMember c -> VariableName
dmName :: VariableName,
    forall c. DefinedMember c -> Maybe (Expression c)
dmInit :: Maybe (Expression c)
  }
  deriving (Int -> DefinedMember c -> ShowS
[DefinedMember c] -> ShowS
DefinedMember c -> String
(Int -> DefinedMember c -> ShowS)
-> (DefinedMember c -> String)
-> ([DefinedMember c] -> ShowS)
-> Show (DefinedMember c)
forall c. Show c => Int -> DefinedMember c -> ShowS
forall c. Show c => [DefinedMember c] -> ShowS
forall c. Show c => DefinedMember c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> DefinedMember c -> ShowS
showsPrec :: Int -> DefinedMember c -> ShowS
$cshow :: forall c. Show c => DefinedMember c -> String
show :: DefinedMember c -> String
$cshowList :: forall c. Show c => [DefinedMember c] -> ShowS
showList :: [DefinedMember c] -> ShowS
Show) -- TODO: Implement Show.

isInitialized :: DefinedMember c -> Bool
isInitialized :: forall c. DefinedMember c -> Bool
isInitialized = Maybe (Expression c) -> Bool
forall {a}. Maybe a -> Bool
check (Maybe (Expression c) -> Bool)
-> (DefinedMember c -> Maybe (Expression c))
-> DefinedMember c
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> Maybe (Expression c)
forall c. DefinedMember c -> Maybe (Expression c)
dmInit where
  check :: Maybe a -> Bool
check Maybe a
Nothing = Bool
False
  check Maybe a
_       = Bool
True

data PragmaDefined c =
  MembersReadOnly {
    forall c. PragmaDefined c -> [c]
mroContext :: [c],
    forall c. PragmaDefined c -> [VariableName]
mroMembers :: [VariableName]
  } |
  MembersReadOnlyExcept {
    forall c. PragmaDefined c -> [c]
mroeContext :: [c],
    forall c. PragmaDefined c -> [VariableName]
mroeMembers :: [VariableName]
  } |
  MembersHidden {
    forall c. PragmaDefined c -> [c]
mhContext :: [c],
    forall c. PragmaDefined c -> [VariableName]
mhMembers :: [VariableName]
  } |
  FlatCleanup {
    forall c. PragmaDefined c -> [c]
fcContext :: [c],
    forall c. PragmaDefined c -> VariableName
fcMember :: VariableName
  }
  deriving (Int -> PragmaDefined c -> ShowS
[PragmaDefined c] -> ShowS
PragmaDefined c -> String
(Int -> PragmaDefined c -> ShowS)
-> (PragmaDefined c -> String)
-> ([PragmaDefined c] -> ShowS)
-> Show (PragmaDefined c)
forall c. Show c => Int -> PragmaDefined c -> ShowS
forall c. Show c => [PragmaDefined c] -> ShowS
forall c. Show c => PragmaDefined c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> PragmaDefined c -> ShowS
showsPrec :: Int -> PragmaDefined c -> ShowS
$cshow :: forall c. Show c => PragmaDefined c -> String
show :: PragmaDefined c -> String
$cshowList :: forall c. Show c => [PragmaDefined c] -> ShowS
showList :: [PragmaDefined c] -> ShowS
Show)

isMembersReadOnly :: PragmaDefined c -> Bool
isMembersReadOnly :: forall c. PragmaDefined c -> Bool
isMembersReadOnly (MembersReadOnly [c]
_ [VariableName]
_) = Bool
True
isMembersReadOnly PragmaDefined c
_                     = Bool
False

isMembersReadOnlyExcept :: PragmaDefined c -> Bool
isMembersReadOnlyExcept :: forall c. PragmaDefined c -> Bool
isMembersReadOnlyExcept (MembersReadOnlyExcept [c]
_ [VariableName]
_) = Bool
True
isMembersReadOnlyExcept PragmaDefined c
_                           = Bool
False

isMembersHidden :: PragmaDefined c -> Bool
isMembersHidden :: forall c. PragmaDefined c -> Bool
isMembersHidden (MembersHidden [c]
_ [VariableName]
_) = Bool
True
isMembersHidden PragmaDefined c
_                   = Bool
False

isFlatCleanup :: PragmaDefined c -> Bool
isFlatCleanup :: forall c. PragmaDefined c -> Bool
isFlatCleanup (FlatCleanup [c]
_ VariableName
_) = Bool
True
isFlatCleanup PragmaDefined c
_                 = Bool
False

data VariableRule c =
  VariableDefault |
  VariableReadOnly {
    forall c. VariableRule c -> [c]
vroContext :: [c]
  } |
  VariableHidden {
    forall c. VariableRule c -> [c]
vhContext :: [c]
  }

data VariableValue c =
  VariableValue {
    forall c. VariableValue c -> [c]
vvContext :: [c],
    forall c. VariableValue c -> SymbolScope
vvScope :: SymbolScope,
    forall c. VariableValue c -> ValueType
vvType :: ValueType,
    forall c. VariableValue c -> VariableRule c
vvReadOnlyAt :: VariableRule c
  }

instance Show c => Show (VariableValue c) where
  show :: VariableValue c -> String
show (VariableValue [c]
c SymbolScope
_ ValueType
t VariableRule c
ro) = ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableRule c -> String
forall {a}. Show a => VariableRule a -> String
format VariableRule c
ro where
    format :: VariableRule a -> String
format (VariableReadOnly [a]
c2) = String
" (read-only at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    format (VariableHidden [a]
c2)   = String
" (hidden at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    format VariableRule a
_ = String
""

setInternalFunctions :: (Show c, CollectErrorsM m, TypeResolver r) =>
  r -> AnyCategory c -> [ScopedFunction c] ->
  m (Map.Map FunctionName (ScopedFunction c))
setInternalFunctions :: forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r
-> AnyCategory c
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
setInternalFunctions r
r AnyCategory c
t [ScopedFunction c]
fs = do
  ParamFilters
fm <- AnyCategory c -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  (ScopedFunction c
 -> m (Map FunctionName (ScopedFunction c))
 -> m (Map FunctionName (ScopedFunction c)))
-> m (Map FunctionName (ScopedFunction c))
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ParamFilters
-> ScopedFunction c
-> m (Map FunctionName (ScopedFunction c))
-> m (Map FunctionName (ScopedFunction c))
forall {m :: * -> *}.
CollectErrorsM m =>
ParamFilters
-> ScopedFunction c
-> m (Map FunctionName (ScopedFunction c))
-> m (Map FunctionName (ScopedFunction c))
update ParamFilters
fm) (Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map FunctionName (ScopedFunction c)
start) [ScopedFunction c]
fs where
  start :: Map FunctionName (ScopedFunction c)
start = [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FunctionName, ScopedFunction c)]
 -> Map FunctionName (ScopedFunction c))
-> [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> (FunctionName, ScopedFunction c))
-> [ScopedFunction c] -> [(FunctionName, ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,ScopedFunction c
f)) ([ScopedFunction c] -> [(FunctionName, ScopedFunction c)])
-> [ScopedFunction c] -> [(FunctionName, ScopedFunction c)]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
  pm :: ParamValues
pm = AnyCategory c -> ParamValues
forall c. AnyCategory c -> ParamValues
getCategoryParamMap AnyCategory c
t
  update :: ParamFilters
-> ScopedFunction c
-> m (Map FunctionName (ScopedFunction c))
-> m (Map FunctionName (ScopedFunction c))
update ParamFilters
fm f :: ScopedFunction c
f@(ScopedFunction [c]
c FunctionName
n CategoryName
t2 SymbolScope
s FunctionVisibility c
v Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs2 [ScopedFunction c]
ms) m (Map FunctionName (ScopedFunction c))
fa = do
    r -> AnyCategory c -> ScopedFunction c -> m ()
forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r -> AnyCategory c -> ScopedFunction c -> m ()
validateCategoryFunction r
r AnyCategory c
t ScopedFunction c
f
    Map FunctionName (ScopedFunction c)
fa' <- m (Map FunctionName (ScopedFunction c))
fa
    case FunctionName
n FunctionName
-> Map FunctionName (ScopedFunction c) -> Maybe (ScopedFunction c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ScopedFunction c)
fa' of
         Maybe (ScopedFunction c)
Nothing -> Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FunctionName (ScopedFunction c)
 -> m (Map FunctionName (ScopedFunction c)))
-> Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall a b. (a -> b) -> a -> b
$ FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
n ScopedFunction c
f Map FunctionName (ScopedFunction c)
fa'
         (Just f0 :: ScopedFunction c
f0@(ScopedFunction [c]
c2 FunctionName
_ CategoryName
_ SymbolScope
_ FunctionVisibility c
_ Positional (PassedValue c, Maybe (CallArgLabel c))
_ Positional (PassedValue c)
_ Positional (ValueParam c)
_ [ParamFilter c]
_ [ScopedFunction c]
ms2)) -> do
           (String
"In function merge:\n---\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall a. Show a => a -> String
show ScopedFunction c
f0 String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
"\n  ->\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall a. Show a => a -> String
show ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n---\n") String -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
              FunctionType
f0' <- ScopedFunction c -> m FunctionType
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f0
              FunctionType
f' <- ScopedFunction c -> m FunctionType
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f
              case SymbolScope
s of
                   SymbolScope
CategoryScope -> r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
checkFunctionConvert r
r ParamFilters
forall k a. Map k a
Map.empty ParamValues
forall k a. Map k a
Map.empty FunctionType
f0' FunctionType
f'
                   SymbolScope
_             -> r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
checkFunctionConvert r
r ParamFilters
fm ParamValues
pm FunctionType
f0' FunctionType
f'
           Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FunctionName (ScopedFunction c)
 -> m (Map FunctionName (ScopedFunction c)))
-> Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall a b. (a -> b) -> a -> b
$ FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
n ([c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> FunctionVisibility c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
forall c.
[c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> FunctionVisibility c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
ScopedFunction ([c]
c[c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++[c]
c2) FunctionName
n CategoryName
t2 SymbolScope
s FunctionVisibility c
v Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs2 ([ScopedFunction c
f0][ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++[ScopedFunction c]
ms[ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++[ScopedFunction c]
ms2)) Map FunctionName (ScopedFunction c)
fa'

pairProceduresToFunctions :: (Show c, CollectErrorsM m) =>
  Map.Map FunctionName (ScopedFunction c) -> [ExecutableProcedure c] ->
  m [(ScopedFunction c,ExecutableProcedure c)]
pairProceduresToFunctions :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map FunctionName (ScopedFunction c)
-> [ExecutableProcedure c]
-> m [(ScopedFunction c, ExecutableProcedure c)]
pairProceduresToFunctions Map FunctionName (ScopedFunction c)
fa [ExecutableProcedure c]
ps = do
  Map FunctionName (ExecutableProcedure c)
pa <- (ExecutableProcedure c
 -> m (Map FunctionName (ExecutableProcedure c))
 -> m (Map FunctionName (ExecutableProcedure c)))
-> m (Map FunctionName (ExecutableProcedure c))
-> [ExecutableProcedure c]
-> m (Map FunctionName (ExecutableProcedure c))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ExecutableProcedure c
-> m (Map FunctionName (ExecutableProcedure c))
-> m (Map FunctionName (ExecutableProcedure c))
forall {m :: * -> *} {c}.
(ErrorContextM m, Show c) =>
ExecutableProcedure c
-> m (Map FunctionName (ExecutableProcedure c))
-> m (Map FunctionName (ExecutableProcedure c))
updateProcedure (Map FunctionName (ExecutableProcedure c)
-> m (Map FunctionName (ExecutableProcedure c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map FunctionName (ExecutableProcedure c)
forall k a. Map k a
Map.empty) [ExecutableProcedure c]
ps
  let allNames :: Set FunctionName
allNames = Set FunctionName -> Set FunctionName -> Set FunctionName
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Map FunctionName (ScopedFunction c) -> Set FunctionName
forall k a. Map k a -> Set k
Map.keysSet Map FunctionName (ScopedFunction c)
fa) (Map FunctionName (ExecutableProcedure c) -> Set FunctionName
forall k a. Map k a -> Set k
Map.keysSet Map FunctionName (ExecutableProcedure c)
pa)
  (FunctionName
 -> m [(ScopedFunction c, ExecutableProcedure c)]
 -> m [(ScopedFunction c, ExecutableProcedure c)])
-> m [(ScopedFunction c, ExecutableProcedure c)]
-> [FunctionName]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Map FunctionName (ScopedFunction c)
-> Map FunctionName (ExecutableProcedure c)
-> FunctionName
-> m [(ScopedFunction c, ExecutableProcedure c)]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall {m :: * -> *} {a} {a} {k}.
(Show a, Show a, CollectErrorsM m, Ord k) =>
Map k (ScopedFunction a)
-> Map k (ExecutableProcedure a)
-> k
-> m [(ScopedFunction a, ExecutableProcedure a)]
-> m [(ScopedFunction a, ExecutableProcedure a)]
updatePairs Map FunctionName (ScopedFunction c)
fa Map FunctionName (ExecutableProcedure c)
pa) ([(ScopedFunction c, ExecutableProcedure c)]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([FunctionName] -> m [(ScopedFunction c, ExecutableProcedure c)])
-> [FunctionName] -> m [(ScopedFunction c, ExecutableProcedure c)]
forall a b. (a -> b) -> a -> b
$ Set FunctionName -> [FunctionName]
forall a. Set a -> [a]
Set.toList Set FunctionName
allNames
  where
    updateProcedure :: ExecutableProcedure c
-> m (Map FunctionName (ExecutableProcedure c))
-> m (Map FunctionName (ExecutableProcedure c))
updateProcedure ExecutableProcedure c
p m (Map FunctionName (ExecutableProcedure c))
pa = do
      Map FunctionName (ExecutableProcedure c)
pa' <- m (Map FunctionName (ExecutableProcedure c))
pa
      case ExecutableProcedure c -> FunctionName
forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p FunctionName
-> Map FunctionName (ExecutableProcedure c)
-> Maybe (ExecutableProcedure c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ExecutableProcedure c)
pa' of
           Maybe (ExecutableProcedure c)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           -- TODO: The error might show things in the wrong order.
           (Just ExecutableProcedure c
p0) -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Procedure " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ExecutableProcedure c -> FunctionName
forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ExecutableProcedure c -> [c]
forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure c
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       String
" is already defined" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ExecutableProcedure c -> [c]
forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure c
p0)
      Map FunctionName (ExecutableProcedure c)
-> m (Map FunctionName (ExecutableProcedure c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FunctionName (ExecutableProcedure c)
 -> m (Map FunctionName (ExecutableProcedure c)))
-> Map FunctionName (ExecutableProcedure c)
-> m (Map FunctionName (ExecutableProcedure c))
forall a b. (a -> b) -> a -> b
$ FunctionName
-> ExecutableProcedure c
-> Map FunctionName (ExecutableProcedure c)
-> Map FunctionName (ExecutableProcedure c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ExecutableProcedure c -> FunctionName
forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p) ExecutableProcedure c
p Map FunctionName (ExecutableProcedure c)
pa'
    updatePairs :: Map k (ScopedFunction a)
-> Map k (ExecutableProcedure a)
-> k
-> m [(ScopedFunction a, ExecutableProcedure a)]
-> m [(ScopedFunction a, ExecutableProcedure a)]
updatePairs Map k (ScopedFunction a)
fa2 Map k (ExecutableProcedure a)
pa k
n m [(ScopedFunction a, ExecutableProcedure a)]
ps2 = do
      [(ScopedFunction a, ExecutableProcedure a)]
ps2' <- m [(ScopedFunction a, ExecutableProcedure a)]
ps2
      (ScopedFunction a, ExecutableProcedure a)
p <- Maybe (ScopedFunction a)
-> Maybe (ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
forall {m :: * -> *} {a} {a}.
(Show a, Show a, CollectErrorsM m) =>
Maybe (ScopedFunction a)
-> Maybe (ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
getPair (k
n k -> Map k (ScopedFunction a) -> Maybe (ScopedFunction a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (ScopedFunction a)
fa2) (k
n k -> Map k (ExecutableProcedure a) -> Maybe (ExecutableProcedure a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (ExecutableProcedure a)
pa)
      [(ScopedFunction a, ExecutableProcedure a)]
-> m [(ScopedFunction a, ExecutableProcedure a)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ScopedFunction a, ExecutableProcedure a)
p(ScopedFunction a, ExecutableProcedure a)
-> [(ScopedFunction a, ExecutableProcedure a)]
-> [(ScopedFunction a, ExecutableProcedure a)]
forall a. a -> [a] -> [a]
:[(ScopedFunction a, ExecutableProcedure a)]
ps2')
    getPair :: Maybe (ScopedFunction a)
-> Maybe (ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
getPair (Just ScopedFunction a
f) Maybe (ExecutableProcedure a)
Nothing =
      String -> m (ScopedFunction a, ExecutableProcedure a)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction a, ExecutableProcedure a))
-> String -> m (ScopedFunction a, ExecutableProcedure a)
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction a -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ScopedFunction a -> [a]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
" has no procedure definition"
    getPair Maybe (ScopedFunction a)
Nothing (Just ExecutableProcedure a
p) =
      String -> m (ScopedFunction a, ExecutableProcedure a)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction a, ExecutableProcedure a))
-> String -> m (ScopedFunction a, ExecutableProcedure a)
forall a b. (a -> b) -> a -> b
$ String
"Procedure " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ExecutableProcedure a -> FunctionName
forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ExecutableProcedure a -> [a]
forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
" does not correspond to a function"
    getPair (Just ScopedFunction a
f) (Just ExecutableProcedure a
p) = do
      (ValueType -> VariableName -> m (ValueType, VariableName))
-> Positional ValueType -> Positional VariableName -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ ValueType -> VariableName -> m (ValueType, VariableName)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair (((PassedValue a, Maybe (CallArgLabel a)) -> ValueType)
-> Positional (PassedValue a, Maybe (CallArgLabel a))
-> Positional ValueType
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PassedValue a -> ValueType
forall c. PassedValue c -> ValueType
pvType (PassedValue a -> ValueType)
-> ((PassedValue a, Maybe (CallArgLabel a)) -> PassedValue a)
-> (PassedValue a, Maybe (CallArgLabel a))
-> ValueType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PassedValue a, Maybe (CallArgLabel a)) -> PassedValue a
forall a b. (a, b) -> a
fst) (Positional (PassedValue a, Maybe (CallArgLabel a))
 -> Positional ValueType)
-> Positional (PassedValue a, Maybe (CallArgLabel a))
-> Positional ValueType
forall a b. (a -> b) -> a -> b
$ ScopedFunction a
-> Positional (PassedValue a, Maybe (CallArgLabel a))
forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction a
f) ((InputValue a -> VariableName)
-> Positional (InputValue a) -> Positional VariableName
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InputValue a -> VariableName
forall c. InputValue c -> VariableName
inputValueName (Positional (InputValue a) -> Positional VariableName)
-> Positional (InputValue a) -> Positional VariableName
forall a b. (a -> b) -> a -> b
$ ArgValues a -> Positional (InputValue a)
forall c. ArgValues c -> Positional (InputValue c)
avNames (ArgValues a -> Positional (InputValue a))
-> ArgValues a -> Positional (InputValue a)
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ArgValues a
forall c. ExecutableProcedure c -> ArgValues c
epArgs ExecutableProcedure a
p) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
        (String
"Procedure for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction a -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
         [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ArgValues a -> [a]
forall c. ArgValues c -> [c]
avContext (ArgValues a -> [a]) -> ArgValues a -> [a]
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ArgValues a
forall c. ExecutableProcedure c -> ArgValues c
epArgs ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
         String
" has the wrong number of arguments" String -> ShowS
forall a. [a] -> [a] -> [a]
++
         [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ScopedFunction a -> [a]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f))
      if ReturnValues a -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns (ExecutableProcedure a -> ReturnValues a
forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p)
         then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else do
           (ValueType -> VariableName -> m (ValueType, VariableName))
-> Positional ValueType -> Positional VariableName -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ ValueType -> VariableName -> m (ValueType, VariableName)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair ((PassedValue a -> ValueType)
-> Positional (PassedValue a) -> Positional ValueType
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PassedValue a -> ValueType
forall c. PassedValue c -> ValueType
pvType (Positional (PassedValue a) -> Positional ValueType)
-> Positional (PassedValue a) -> Positional ValueType
forall a b. (a -> b) -> a -> b
$ ScopedFunction a -> Positional (PassedValue a)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction a
f) ((OutputValue a -> VariableName)
-> Positional (OutputValue a) -> Positional VariableName
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OutputValue a -> VariableName
forall c. OutputValue c -> VariableName
ovName (Positional (OutputValue a) -> Positional VariableName)
-> Positional (OutputValue a) -> Positional VariableName
forall a b. (a -> b) -> a -> b
$ ReturnValues a -> Positional (OutputValue a)
forall c. ReturnValues c -> Positional (OutputValue c)
nrNames (ReturnValues a -> Positional (OutputValue a))
-> ReturnValues a -> Positional (OutputValue a)
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ReturnValues a
forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
             (String
"Procedure for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction a -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
              [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ReturnValues a -> [a]
forall c. ReturnValues c -> [c]
nrContext (ReturnValues a -> [a]) -> ReturnValues a -> [a]
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ReturnValues a
forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
" has the wrong number of returns" String -> ShowS
forall a. [a] -> [a] -> [a]
++
              [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ScopedFunction a -> [a]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f))
           () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (ScopedFunction a, ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedFunction a
f,ExecutableProcedure a
p)
    getPair Maybe (ScopedFunction a)
_ Maybe (ExecutableProcedure a)
_ = m (ScopedFunction a, ExecutableProcedure a)
forall a. HasCallStack => a
undefined

mapMembers :: (Show c, CollectErrorsM m) =>
  Map.Map VariableName [c] -> Map.Map VariableName [c] -> [DefinedMember c] ->
  m (Map.Map VariableName (VariableValue c))
mapMembers :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly Map VariableName [c]
hidden [DefinedMember c]
ms = (DefinedMember c
 -> m (Map VariableName (VariableValue c))
 -> m (Map VariableName (VariableValue c)))
-> m (Map VariableName (VariableValue c))
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DefinedMember c
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
forall {m :: * -> *}.
ErrorContextM m =>
DefinedMember c
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
update (Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map VariableName (VariableValue c)
forall k a. Map k a
Map.empty) [DefinedMember c]
ms where
  update :: DefinedMember c
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
update DefinedMember c
m m (Map VariableName (VariableValue c))
ma = do
    Map VariableName (VariableValue c)
ma' <- m (Map VariableName (VariableValue c))
ma
    case DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m VariableName
-> Map VariableName (VariableValue c) -> Maybe (VariableValue c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName (VariableValue c)
ma' of
         Maybe (VariableValue c)
Nothing ->  () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         -- TODO: The error might show things in the wrong order.
         (Just VariableValue c
m0) -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Member " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (DefinedMember c -> [c]
forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     String
" is already defined" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (VariableValue c -> [c]
forall c. VariableValue c -> [c]
vvContext VariableValue c
m0)
    Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map VariableName (VariableValue c)
 -> m (Map VariableName (VariableValue c)))
-> Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall a b. (a -> b) -> a -> b
$ VariableName
-> VariableValue c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue (DefinedMember c -> [c]
forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) (DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope DefinedMember c
m) (DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) (DefinedMember c -> VariableRule c
forall {c}. DefinedMember c -> VariableRule c
memberRule DefinedMember c
m)) Map VariableName (VariableValue c)
ma'
  memberRule :: DefinedMember c -> VariableRule c
memberRule DefinedMember c
m =
    case (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m VariableName -> Map VariableName [c] -> Maybe [c]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName [c]
hidden,DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m VariableName -> Map VariableName [c] -> Maybe [c]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName [c]
readOnly) of
         (Just [c]
c,Maybe [c]
_) -> [c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableHidden   [c]
c
         (Maybe [c]
_,Just [c]
c) -> [c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableReadOnly [c]
c
         (Maybe [c], Maybe [c])
_ -> VariableRule c
forall c. VariableRule c
VariableDefault

-- TODO: Most of this duplicates parts of flattenAllConnections.
mergeInternalInheritance :: (Show c, CollectErrorsM m) =>
  CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance cm :: CategoryMap c
cm@(CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm) DefinedCategory c
d = String
"In definition of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) String -> m (CategoryMap c) -> m (CategoryMap c)
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  let rs2 :: [ValueRefine c]
rs2 = DefinedCategory c -> [ValueRefine c]
forall c. DefinedCategory c -> [ValueRefine c]
dcRefines DefinedCategory c
d
  let ds2 :: [ValueDefine c]
ds2 = DefinedCategory c -> [ValueDefine c]
forall c. DefinedCategory c -> [ValueDefine c]
dcDefines DefinedCategory c
d
  ([c]
_,t :: AnyCategory c
t@(ValueConcrete [c]
c Namespace
ns CategoryName
n [PragmaCategory c]
pg [FunctionVisibility c]
fv [ValueParam c]
ps [ValueRefine c]
rs [ValueDefine c]
ds [ParamFilter c]
vs [ScopedFunction c]
fs)) <- 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
cm (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d,DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d)
  let c2 :: AnyCategory c
c2 = [c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [FunctionVisibility c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [FunctionVisibility c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
ValueConcrete [c]
c Namespace
ns CategoryName
n [PragmaCategory c]
pg [FunctionVisibility c]
fv [ValueParam c]
ps ([ValueRefine c]
rs[ValueRefine c] -> [ValueRefine c] -> [ValueRefine c]
forall a. [a] -> [a] -> [a]
++[ValueRefine c]
rs2) ([ValueDefine c]
ds[ValueDefine c] -> [ValueDefine c] -> [ValueDefine c]
forall a. [a] -> [a] -> [a]
++[ValueDefine c]
ds2) [ParamFilter c]
vs [ScopedFunction c]
fs
  let tm' :: Map CategoryName (AnyCategory c)
tm' = CategoryName
-> AnyCategory c
-> Map CategoryName (AnyCategory c)
-> Map CategoryName (AnyCategory c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) AnyCategory c
c2 Map CategoryName (AnyCategory c)
tm
  let r :: CategoryResolver c
r = CategoryMap c -> CategoryResolver c
forall c. CategoryMap c -> CategoryResolver c
CategoryResolver (Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm')
  ParamFilters
fm <- AnyCategory c -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  let pm :: ParamValues
pm = AnyCategory c -> ParamValues
forall c. AnyCategory c -> ParamValues
getCategoryParamMap AnyCategory c
t
  [ValueRefine c]
rs2' <- ([[ValueRefine c]] -> [ValueRefine c])
-> m [[ValueRefine c]] -> m [ValueRefine c]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[ValueRefine c]] -> [ValueRefine c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[ValueRefine c]] -> m [ValueRefine c])
-> m [[ValueRefine c]] -> m [ValueRefine c]
forall a b. (a -> b) -> a -> b
$ (ValueRefine c -> m [ValueRefine c])
-> [ValueRefine c] -> m [[ValueRefine c]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryResolver c -> ValueRefine c -> m [ValueRefine c]
forall {m :: * -> *} {r}.
(CollectErrorsM m, TypeResolver r) =>
r -> ValueRefine c -> m [ValueRefine c]
flattenRefine CategoryResolver c
r) [ValueRefine c]
rs2
  [ValueRefine c]
rs' <- CategoryResolver c
-> ParamFilters -> [ValueRefine c] -> m [ValueRefine c]
forall (m :: * -> *) r c.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> [ValueRefine c] -> m [ValueRefine c]
mergeRefines CategoryResolver c
r ParamFilters
fm ([ValueRefine c]
rs[ValueRefine c] -> [ValueRefine c] -> [ValueRefine c]
forall a. [a] -> [a] -> [a]
++[ValueRefine c]
rs2')
  [c] -> CategoryName -> [ValueRefine c] -> m ()
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
[c] -> CategoryName -> [ValueRefine c] -> m ()
noDuplicateRefines (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) CategoryName
n [ValueRefine c]
rs'
  [ValueDefine c]
ds' <- CategoryResolver c
-> ParamFilters -> [ValueDefine c] -> m [ValueDefine c]
forall (m :: * -> *) r c.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> [ValueDefine c] -> m [ValueDefine c]
mergeDefines CategoryResolver c
r ParamFilters
fm ([ValueDefine c]
ds[ValueDefine c] -> [ValueDefine c] -> [ValueDefine c]
forall a. [a] -> [a] -> [a]
++[ValueDefine c]
ds2)
  [c] -> CategoryName -> [ValueDefine c] -> m ()
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
[c] -> CategoryName -> [ValueDefine c] -> m ()
noDuplicateDefines (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) CategoryName
n [ValueDefine c]
ds'
  let vm :: Map ParamName Variance
vm = [(ParamName, Variance)] -> Map ParamName Variance
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ParamName, Variance)] -> Map ParamName Variance)
-> [(ParamName, Variance)] -> Map ParamName Variance
forall a b. (a -> b) -> a -> b
$ (ValueParam c -> (ParamName, Variance))
-> [ValueParam c] -> [(ParamName, Variance)]
forall a b. (a -> b) -> [a] -> [b]
map (\ValueParam c
p -> (ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam c
p,ValueParam c -> Variance
forall c. ValueParam c -> Variance
vpVariance ValueParam c
p)) [ValueParam c]
ps
  (ValueRefine c -> m ()) -> [ValueRefine c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (CategoryResolver c
-> Map ParamName Variance -> ValueRefine c -> m ()
forall {m :: * -> *} {r} {a}.
(CollectErrorsM m, TypeResolver r, Show a) =>
r -> Map ParamName Variance -> ValueRefine a -> m ()
checkRefinesVariance CategoryResolver c
r Map ParamName Variance
vm) [ValueRefine c]
rs2
  (ValueDefine c -> m ()) -> [ValueDefine c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (CategoryResolver c
-> Map ParamName Variance -> ValueDefine c -> m ()
forall {m :: * -> *} {r} {a}.
(CollectErrorsM m, TypeResolver r, Show a) =>
r -> Map ParamName Variance -> ValueDefine a -> m ()
checkDefinesVariance CategoryResolver c
r Map ParamName Variance
vm) [ValueDefine c]
ds2
  [PragmaCategory c]
pg2 <- ([[PragmaCategory c]] -> [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[PragmaCategory c]] -> [PragmaCategory c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[PragmaCategory c]] -> m [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (ValueRefine c -> m [PragmaCategory c])
-> [ValueRefine c] -> m [[PragmaCategory c]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ValueRefine c -> m [PragmaCategory c]
forall {m :: * -> *}.
CollectErrorsM m =>
ValueRefine c -> m [PragmaCategory c]
getRefinesPragmas [ValueRefine c]
rs2
  [PragmaCategory c]
pg3 <- ([[PragmaCategory c]] -> [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[PragmaCategory c]] -> [PragmaCategory c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[PragmaCategory c]] -> m [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (ValueDefine c -> m [PragmaCategory c])
-> [ValueDefine c] -> m [[PragmaCategory c]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ValueDefine c -> m [PragmaCategory c]
forall {m :: * -> *}.
CollectErrorsM m =>
ValueDefine c -> m [PragmaCategory c]
getDefinesPragmas [ValueDefine c]
ds2
  let fs2 :: [ScopedFunction c]
fs2 = [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall {t :: * -> *} {c}.
Foldable t =>
[ScopedFunction c] -> t (ScopedFunction c) -> [ScopedFunction c]
mergeInternalFunctions [ScopedFunction c]
fs (DefinedCategory c -> [ScopedFunction c]
forall c. DefinedCategory c -> [ScopedFunction c]
dcFunctions DefinedCategory c
d)
  [ScopedFunction c]
fs' <- CategoryResolver c
-> CategoryMap c
-> ParamValues
-> ParamFilters
-> [ValueRefine c]
-> [ValueDefine c]
-> [ScopedFunction c]
-> m [ScopedFunction c]
forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r
-> CategoryMap c
-> ParamValues
-> ParamFilters
-> [ValueRefine c]
-> [ValueDefine c]
-> [ScopedFunction c]
-> m [ScopedFunction c]
mergeFunctions CategoryResolver c
r (Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm') ParamValues
pm ParamFilters
fm [ValueRefine c]
rs' [ValueDefine c]
ds' [ScopedFunction c]
fs2
  let c2' :: AnyCategory c
c2' = [c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [FunctionVisibility c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [FunctionVisibility c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
ValueConcrete [c]
c Namespace
ns CategoryName
n ([PragmaCategory c]
pg[PragmaCategory c] -> [PragmaCategory c] -> [PragmaCategory c]
forall a. [a] -> [a] -> [a]
++[PragmaCategory c]
pg2[PragmaCategory c] -> [PragmaCategory c] -> [PragmaCategory c]
forall a. [a] -> [a] -> [a]
++[PragmaCategory c]
pg3) [FunctionVisibility c]
fv [ValueParam c]
ps [ValueRefine c]
rs' [ValueDefine c]
ds' [ParamFilter c]
vs [ScopedFunction c]
fs'
  let tm0 :: Map CategoryName (AnyCategory c)
tm0 = (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) CategoryName
-> Map CategoryName (AnyCategory c)
-> Map CategoryName (AnyCategory c)
forall k a. Ord k => k -> Map k a -> Map k a
`Map.delete` Map CategoryName (AnyCategory c)
tm
  CategoryMap c -> [AnyCategory c] -> m ()
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m ()
checkCategoryInstances (Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm0) [AnyCategory c
c2']
  CategoryMap c -> m (CategoryMap c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryMap c -> m (CategoryMap c))
-> CategoryMap c -> m (CategoryMap c)
forall a b. (a -> b) -> a -> b
$ Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km (Map CategoryName (AnyCategory c) -> CategoryMap c)
-> Map CategoryName (AnyCategory c) -> CategoryMap c
forall a b. (a -> b) -> a -> b
$ CategoryName
-> AnyCategory c
-> Map CategoryName (AnyCategory c)
-> Map CategoryName (AnyCategory c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) AnyCategory c
c2' Map CategoryName (AnyCategory c)
tm
  where
    getRefinesPragmas :: ValueRefine c -> m [PragmaCategory c]
getRefinesPragmas ValueRefine c
rf = do
      ([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)
getCategory CategoryMap c
cm (ValueRefine c -> [c]
forall c. ValueRefine c -> [c]
vrContext ValueRefine c
rf,TypeInstance -> CategoryName
tiName (TypeInstance -> CategoryName) -> TypeInstance -> CategoryName
forall a b. (a -> b) -> a -> b
$ ValueRefine c -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType ValueRefine c
rf)
      [PragmaCategory c] -> m [PragmaCategory c]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PragmaCategory c] -> m [PragmaCategory c])
-> [PragmaCategory c] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (PragmaCategory c -> PragmaCategory c)
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> [a] -> [b]
map ([c] -> PragmaCategory c -> PragmaCategory c
forall c. [c] -> PragmaCategory c -> PragmaCategory c
prependCategoryPragmaContext ([c] -> PragmaCategory c -> PragmaCategory c)
-> [c] -> PragmaCategory c -> PragmaCategory c
forall a b. (a -> b) -> a -> b
$ ValueRefine c -> [c]
forall c. ValueRefine c -> [c]
vrContext ValueRefine c
rf) ([PragmaCategory c] -> [PragmaCategory c])
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [PragmaCategory c]
forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas AnyCategory c
t
    getDefinesPragmas :: ValueDefine c -> m [PragmaCategory c]
getDefinesPragmas ValueDefine c
df = do
      ([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)
getCategory CategoryMap c
cm (ValueDefine c -> [c]
forall c. ValueDefine c -> [c]
vdContext ValueDefine c
df,DefinesInstance -> CategoryName
diName (DefinesInstance -> CategoryName)
-> DefinesInstance -> CategoryName
forall a b. (a -> b) -> a -> b
$ ValueDefine c -> DefinesInstance
forall c. ValueDefine c -> DefinesInstance
vdType ValueDefine c
df)
      [PragmaCategory c] -> m [PragmaCategory c]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PragmaCategory c] -> m [PragmaCategory c])
-> [PragmaCategory c] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (PragmaCategory c -> PragmaCategory c)
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> [a] -> [b]
map ([c] -> PragmaCategory c -> PragmaCategory c
forall c. [c] -> PragmaCategory c -> PragmaCategory c
prependCategoryPragmaContext ([c] -> PragmaCategory c -> PragmaCategory c)
-> [c] -> PragmaCategory c -> PragmaCategory c
forall a b. (a -> b) -> a -> b
$ ValueDefine c -> [c]
forall c. ValueDefine c -> [c]
vdContext ValueDefine c
df) ([PragmaCategory c] -> [PragmaCategory c])
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [PragmaCategory c]
forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas AnyCategory c
t
    mergeInternalFunctions :: [ScopedFunction c] -> t (ScopedFunction c) -> [ScopedFunction c]
mergeInternalFunctions [ScopedFunction c]
fs1 = Map FunctionName (ScopedFunction c) -> [ScopedFunction c]
forall k a. Map k a -> [a]
Map.elems (Map FunctionName (ScopedFunction c) -> [ScopedFunction c])
-> (t (ScopedFunction c) -> Map FunctionName (ScopedFunction c))
-> t (ScopedFunction c)
-> [ScopedFunction c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c
 -> Map FunctionName (ScopedFunction c)
 -> Map FunctionName (ScopedFunction c))
-> Map FunctionName (ScopedFunction c)
-> t (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall {c}.
ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
single ([ScopedFunction c] -> Map FunctionName (ScopedFunction c)
forall {c}.
[ScopedFunction c] -> Map FunctionName (ScopedFunction c)
funcMap [ScopedFunction c]
fs1)
    funcMap :: [ScopedFunction c] -> Map FunctionName (ScopedFunction c)
funcMap = [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FunctionName, ScopedFunction c)]
 -> Map FunctionName (ScopedFunction c))
-> ([ScopedFunction c] -> [(FunctionName, ScopedFunction c)])
-> [ScopedFunction c]
-> Map FunctionName (ScopedFunction c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c -> (FunctionName, ScopedFunction c))
-> [ScopedFunction c] -> [(FunctionName, ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,ScopedFunction c
f))
    single :: ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
single ScopedFunction c
f Map FunctionName (ScopedFunction c)
fm =
      case ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f FunctionName
-> Map FunctionName (ScopedFunction c) -> Maybe (ScopedFunction c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ScopedFunction c)
fm of
           Maybe (ScopedFunction c)
Nothing -> FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) ScopedFunction c
f Map FunctionName (ScopedFunction c)
fm
           Just ScopedFunction c
f2 -> FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) (ScopedFunction {
               sfContext :: [c]
sfContext = ScopedFunction c -> [c]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction c
f,
               sfName :: FunctionName
sfName = ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,
               sfType :: CategoryName
sfType = ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f,
               sfScope :: SymbolScope
sfScope = ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f,
               sfVisibility :: FunctionVisibility c
sfVisibility = ScopedFunction c -> FunctionVisibility c
forall c. ScopedFunction c -> FunctionVisibility c
sfVisibility ScopedFunction c
f,
               sfArgs :: Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs = ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f,
               sfReturns :: Positional (PassedValue c)
sfReturns = ScopedFunction c -> Positional (PassedValue c)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction c
f,
               sfParams :: Positional (ValueParam c)
sfParams = ScopedFunction c -> Positional (ValueParam c)
forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f,
               sfFilters :: [ParamFilter c]
sfFilters = ScopedFunction c -> [ParamFilter c]
forall c. ScopedFunction c -> [ParamFilter c]
sfFilters ScopedFunction c
f,
               sfMerges :: [ScopedFunction c]
sfMerges = ScopedFunction c -> [ScopedFunction c]
forall c. ScopedFunction c -> [ScopedFunction c]
sfMerges ScopedFunction c
f [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++ [ScopedFunction c
f2]
             }) Map FunctionName (ScopedFunction c)
fm
    checkRefinesVariance :: r -> Map ParamName Variance -> ValueRefine a -> m ()
checkRefinesVariance r
r Map ParamName Variance
vm (ValueRefine [a]
c TypeInstance
t) =
      r -> Map ParamName Variance -> Variance -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Map ParamName Variance -> Variance -> GeneralInstance -> m ()
validateInstanceVariance r
r Map ParamName Variance
vm Variance
Covariant (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance TypeInstance
t) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        String
"In " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeInstance -> String
forall a. Show a => a -> String
show TypeInstance
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
    checkDefinesVariance :: r -> Map ParamName Variance -> ValueDefine a -> m ()
checkDefinesVariance r
r Map ParamName Variance
vm (ValueDefine [a]
c DefinesInstance
t) =
      r -> Map ParamName Variance -> Variance -> DefinesInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Map ParamName Variance -> Variance -> DefinesInstance -> m ()
validateDefinesVariance r
r Map ParamName Variance
vm Variance
Covariant DefinesInstance
t m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        String
"In " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DefinesInstance -> String
forall a. Show a => a -> String
show DefinesInstance
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
    flattenRefine :: r -> ValueRefine c -> m [ValueRefine c]
flattenRefine r
r ra :: ValueRefine c
ra@(ValueRefine [c]
c TypeInstance
t) = do
      ([c]
_,AnyCategory c
t2) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getValueCategory CategoryMap c
cm ([c]
c,TypeInstance -> CategoryName
tiName TypeInstance
t)
      [ValueRefine c]
rs <- (ValueRefine c -> m (ValueRefine c))
-> [ValueRefine c] -> m [ValueRefine c]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (r -> ValueRefine c -> ValueRefine c -> m (ValueRefine c)
forall {m :: * -> *} {r} {c}.
(TypeResolver r, CollectErrorsM m) =>
r -> ValueRefine c -> ValueRefine c -> m (ValueRefine c)
singleRefine r
r ValueRefine c
ra) (AnyCategory c -> [ValueRefine c]
forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t2)
      [ValueRefine c] -> m [ValueRefine c]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValueRefine c
raValueRefine c -> [ValueRefine c] -> [ValueRefine c]
forall a. a -> [a] -> [a]
:[ValueRefine c]
rs)
    singleRefine :: r -> ValueRefine c -> ValueRefine c -> m (ValueRefine c)
singleRefine r
r (ValueRefine [c]
c TypeInstance
t) (ValueRefine [c]
c2 TypeInstance
t2) = do
      InstanceParams
ps <- r -> TypeInstance -> CategoryName -> m InstanceParams
forall r (m :: * -> *).
(TypeResolver r, CollectErrorsM m) =>
r -> TypeInstance -> CategoryName -> m InstanceParams
forall (m :: * -> *).
CollectErrorsM m =>
r -> TypeInstance -> CategoryName -> m InstanceParams
trRefines r
r TypeInstance
t (TypeInstance -> CategoryName
tiName TypeInstance
t2)
      ValueRefine c -> m (ValueRefine c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValueRefine c -> m (ValueRefine c))
-> ValueRefine c -> m (ValueRefine c)
forall a b. (a -> b) -> a -> b
$ [c] -> TypeInstance -> ValueRefine c
forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine ([c]
c[c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++[c]
c2) (CategoryName -> InstanceParams -> TypeInstance
TypeInstance (TypeInstance -> CategoryName
tiName TypeInstance
t2) InstanceParams
ps)

replaceSelfMember :: (Show c, CollectErrorsM m) =>
  GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember GeneralInstance
self (DefinedMember [c]
c SymbolScope
s ValueType
t VariableName
n Maybe (Expression c)
i) = do
  ValueType
t' <- GeneralInstance -> ValueType -> m ValueType
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> ValueType -> m ValueType
replaceSelfValueType GeneralInstance
self ValueType
t
  DefinedMember c -> m (DefinedMember c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DefinedMember c -> m (DefinedMember c))
-> DefinedMember c -> m (DefinedMember c)
forall a b. (a -> b) -> a -> b
$ [c]
-> SymbolScope
-> ValueType
-> VariableName
-> Maybe (Expression c)
-> DefinedMember c
forall c.
[c]
-> SymbolScope
-> ValueType
-> VariableName
-> Maybe (Expression c)
-> DefinedMember c
DefinedMember [c]
c SymbolScope
s ValueType
t' VariableName
n Maybe (Expression c)
i