{-# 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)
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)
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 ()
(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 ()
(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
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