{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe #-}
module Compilation.ProcedureContext (
ExprMap,
ProcedureContext(..),
ReturnValidation(..),
updateArgVariables,
updateReturnVariables,
) where
import Control.Monad (when)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Base.CompileError
import Base.MergeTree
import Compilation.CompilerState
import Types.DefinedCategory
import Types.GeneralType
import Types.Positional
import Types.Pragma (MacroName)
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance
data ProcedureContext c =
ProcedureContext {
ProcedureContext c -> SymbolScope
pcScope :: SymbolScope,
ProcedureContext c -> CategoryName
pcType :: CategoryName,
ProcedureContext c -> Positional (ValueParam c)
pcExtParams :: Positional (ValueParam c),
ProcedureContext c -> Positional (ValueParam c)
pcIntParams :: Positional (ValueParam c),
ProcedureContext c -> [DefinedMember c]
pcMembers :: [DefinedMember c],
ProcedureContext c -> CategoryMap c
pcCategories :: CategoryMap c,
ProcedureContext c -> ParamFilters
pcAllFilters :: ParamFilters,
ProcedureContext c -> [ParamFilter c]
pcExtFilters :: [ParamFilter c],
ProcedureContext c -> [ParamFilter c]
pcIntFilters :: [ParamFilter c],
ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes :: Map.Map ParamName SymbolScope,
ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions :: Map.Map FunctionName (ScopedFunction c),
ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables :: Map.Map VariableName (VariableValue c),
ProcedureContext c -> ReturnValidation c
pcReturns :: ReturnValidation c,
ProcedureContext c -> JumpType
pcJumpType :: JumpType,
ProcedureContext c -> Bool
pcIsNamed :: Bool,
ProcedureContext c -> [ReturnVariable]
pcPrimNamed :: [ReturnVariable],
ProcedureContext c -> Set CategoryName
pcRequiredTypes :: Set.Set CategoryName,
ProcedureContext c -> [String]
pcOutput :: [String],
ProcedureContext c -> Bool
pcDisallowInit :: Bool,
ProcedureContext c -> LoopSetup [String]
pcLoopSetup :: LoopSetup [String],
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]],
ProcedureContext c -> Bool
pcInCleanup :: Bool,
ProcedureContext c -> ExprMap c
pcExprMap :: ExprMap c,
ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros :: [(MacroName,[c])],
ProcedureContext c -> Bool
pcNoTrace :: Bool
}
type ExprMap c = Map.Map MacroName (Expression c)
data ReturnValidation c =
ValidatePositions {
ReturnValidation c -> Positional (PassedValue c)
vpReturns :: Positional (PassedValue c)
} |
ValidateNames {
ReturnValidation c -> Positional VariableName
vnNames :: Positional VariableName,
ReturnValidation c -> Positional (PassedValue c)
vnTypes :: Positional (PassedValue c),
ReturnValidation c -> Map VariableName (PassedValue c)
vnRemaining :: Map.Map VariableName (PassedValue c)
}
instance (Show c, CompileErrorM m) =>
CompilerContext c m [String] (ProcedureContext c) where
ccCurrentScope :: ProcedureContext c -> m SymbolScope
ccCurrentScope = SymbolScope -> m SymbolScope
forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolScope -> m SymbolScope)
-> (ProcedureContext c -> SymbolScope)
-> ProcedureContext c
-> m SymbolScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope
ccResolver :: ProcedureContext c -> m AnyTypeResolver
ccResolver = AnyTypeResolver -> m AnyTypeResolver
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyTypeResolver -> m AnyTypeResolver)
-> (ProcedureContext c -> AnyTypeResolver)
-> ProcedureContext c
-> m AnyTypeResolver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategoryResolver c -> AnyTypeResolver
forall r. TypeResolver r => r -> AnyTypeResolver
AnyTypeResolver (CategoryResolver c -> AnyTypeResolver)
-> (ProcedureContext c -> CategoryResolver c)
-> ProcedureContext c
-> AnyTypeResolver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CategoryMap c -> CategoryResolver c
forall c. CategoryMap c -> CategoryResolver c
CategoryResolver (CategoryMap c -> CategoryResolver c)
-> (ProcedureContext c -> CategoryMap c)
-> ProcedureContext c
-> CategoryResolver c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories
ccSameType :: ProcedureContext c -> TypeInstance -> m Bool
ccSameType ProcedureContext c
ctx = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool)
-> (TypeInstance -> Bool) -> TypeInstance -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeInstance -> TypeInstance -> Bool
forall a. Eq a => a -> a -> Bool
== TypeInstance
same) where
same :: TypeInstance
same = CategoryName -> Positional GeneralInstance -> TypeInstance
TypeInstance (ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx) ((ValueParam c -> GeneralInstance)
-> Positional (ValueParam c) -> Positional GeneralInstance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> (ValueParam c -> TypeInstanceOrParam)
-> ValueParam c
-> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False (ParamName -> TypeInstanceOrParam)
-> (ValueParam c -> ParamName)
-> ValueParam c
-> TypeInstanceOrParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam) (Positional (ValueParam c) -> Positional GeneralInstance)
-> Positional (ValueParam c) -> Positional GeneralInstance
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx)
ccAllFilters :: ProcedureContext c -> m ParamFilters
ccAllFilters = ParamFilters -> m ParamFilters
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamFilters -> m ParamFilters)
-> (ProcedureContext c -> ParamFilters)
-> ProcedureContext c
-> m ParamFilters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters
ccGetParamScope :: ProcedureContext c -> ParamName -> m SymbolScope
ccGetParamScope ProcedureContext c
ctx ParamName
p = do
case ParamName
p ParamName -> Map ParamName SymbolScope -> Maybe SymbolScope
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx of
(Just SymbolScope
s) -> SymbolScope -> m SymbolScope
forall (m :: * -> *) a. Monad m => a -> m a
return SymbolScope
s
Maybe SymbolScope
_ -> String -> m SymbolScope
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m SymbolScope) -> String -> m SymbolScope
forall a b. (a -> b) -> a -> b
$ String
"Param " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not exist"
ccRequiresTypes :: ProcedureContext c -> Set CategoryName -> m (ProcedureContext c)
ccRequiresTypes ProcedureContext c
ctx Set CategoryName
ts = ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$
ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
Set.union (ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx) Set CategoryName
ts,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccGetRequired :: ProcedureContext c -> m (Set CategoryName)
ccGetRequired = Set CategoryName -> m (Set CategoryName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set CategoryName -> m (Set CategoryName))
-> (ProcedureContext c -> Set CategoryName)
-> ProcedureContext c
-> m (Set CategoryName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes
ccGetCategoryFunction :: ProcedureContext c
-> [c]
-> Maybe CategoryName
-> FunctionName
-> m (ScopedFunction c)
ccGetCategoryFunction ProcedureContext c
ctx [c]
c Maybe CategoryName
Nothing FunctionName
n = ProcedureContext c
-> [c]
-> Maybe CategoryName
-> FunctionName
-> m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a
-> [c]
-> Maybe CategoryName
-> FunctionName
-> m (ScopedFunction c)
ccGetCategoryFunction ProcedureContext c
ctx [c]
c (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just (CategoryName -> Maybe CategoryName)
-> CategoryName -> Maybe CategoryName
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx) FunctionName
n
ccGetCategoryFunction ProcedureContext c
ctx [c]
c (Just CategoryName
t) FunctionName
n = m (ScopedFunction c)
getFunction where
getFunction :: m (ScopedFunction c)
getFunction
| CategoryName
t CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx = Maybe (ScopedFunction c) -> m (ScopedFunction c)
forall (m :: * -> *) c.
CompileErrorM m =>
Maybe (ScopedFunction c) -> m (ScopedFunction c)
checkFunction (Maybe (ScopedFunction c) -> m (ScopedFunction c))
-> Maybe (ScopedFunction c) -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ FunctionName
n FunctionName
-> Map FunctionName (ScopedFunction c) -> Maybe (ScopedFunction c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx
| Bool
otherwise = do
([c]
_,AnyCategory c
ca) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getCategory (ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx) ([c]
c,CategoryName
t)
let fa :: Map FunctionName (ScopedFunction c)
fa = [(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
ca
Maybe (ScopedFunction c) -> m (ScopedFunction c)
forall (m :: * -> *) c.
CompileErrorM m =>
Maybe (ScopedFunction c) -> m (ScopedFunction c)
checkFunction (Maybe (ScopedFunction c) -> m (ScopedFunction c))
-> Maybe (ScopedFunction c) -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ 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
checkFunction :: Maybe (ScopedFunction c) -> m (ScopedFunction c)
checkFunction (Just ScopedFunction c
f) = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx Bool -> Bool -> Bool
&& CategoryName
t CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx Bool -> Bool -> Bool
&& ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" disallowed during initialization" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
/= SymbolScope
CategoryScope) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be used as a category function"
ScopedFunction c -> m (ScopedFunction c)
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedFunction c
f
checkFunction Maybe (ScopedFunction c)
_ =
String -> m (ScopedFunction c)
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m (ScopedFunction c)) -> String -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" does not have a category function named " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
[c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
ccGetTypeFunction :: ProcedureContext c
-> [c]
-> Maybe GeneralInstance
-> FunctionName
-> m (ScopedFunction c)
ccGetTypeFunction ProcedureContext c
ctx [c]
c Maybe GeneralInstance
t FunctionName
n = Maybe GeneralInstance -> m (ScopedFunction c)
forall (m :: * -> *).
CompileErrorM m =>
Maybe GeneralInstance -> m (ScopedFunction c)
getFunction Maybe GeneralInstance
t where
getFunction :: Maybe GeneralInstance -> m (ScopedFunction c)
getFunction (Just GeneralInstance
t2) = ([m (ScopedFunction c)] -> m (ScopedFunction c))
-> ([m (ScopedFunction c)] -> m (ScopedFunction c))
-> (T GeneralInstance -> m (ScopedFunction c))
-> GeneralInstance
-> m (ScopedFunction c)
forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [m (ScopedFunction c)] -> m (ScopedFunction c)
forall (m :: * -> *) p a. CompileErrorM m => p -> m a
getFromAny [m (ScopedFunction c)] -> m (ScopedFunction c)
forall (m :: * -> *) (f :: * -> *) a.
(CompileErrorM m, Foldable f) =>
f (m a) -> m a
getFromAll T GeneralInstance -> m (ScopedFunction c)
TypeInstanceOrParam -> m (ScopedFunction c)
getFromSingle GeneralInstance
t2
getFunction Maybe GeneralInstance
Nothing = do
let ps :: Positional GeneralInstance
ps = (ValueParam c -> GeneralInstance)
-> Positional (ValueParam c) -> Positional GeneralInstance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> (ValueParam c -> TypeInstanceOrParam)
-> ValueParam c
-> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False (ParamName -> TypeInstanceOrParam)
-> (ValueParam c -> ParamName)
-> ValueParam c
-> TypeInstanceOrParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam) (Positional (ValueParam c) -> Positional GeneralInstance)
-> Positional (ValueParam c) -> Positional GeneralInstance
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx
Maybe GeneralInstance -> m (ScopedFunction c)
getFunction (GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just (GeneralInstance -> Maybe GeneralInstance)
-> GeneralInstance -> Maybe GeneralInstance
forall a b. (a -> b) -> a -> b
$ 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 -> TypeInstanceOrParam)
-> TypeInstance -> TypeInstanceOrParam
forall a b. (a -> b) -> a -> b
$ CategoryName -> Positional GeneralInstance -> TypeInstance
TypeInstance (ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx) Positional GeneralInstance
ps)
getFromAny :: p -> m a
getFromAny p
_ =
String -> m a
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Use explicit type conversion to call " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe GeneralInstance -> String
forall a. Show a => a -> String
show Maybe GeneralInstance
t
getFromAll :: f (m a) -> m a
getFromAll f (m a)
ts = do
f (m a) -> m a
forall (m :: * -> *) (f :: * -> *) a.
(CompileErrorM m, Foldable f) =>
f (m a) -> m a
collectFirstM f (m a)
ts m a -> String -> m a
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<!!
String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not available for type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe GeneralInstance -> String
forall a. Show a => a -> String
show Maybe GeneralInstance
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
getFromSingle :: TypeInstanceOrParam -> m (ScopedFunction c)
getFromSingle (JustParamName Bool
_ ParamName
p) = do
ParamFilters
fa <- ProcedureContext c -> m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m ParamFilters
ccAllFilters ProcedureContext c
ctx
[TypeFilter]
fs <- case ParamName
p ParamName -> ParamFilters -> Maybe [TypeFilter]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ParamFilters
fa of
(Just [TypeFilter]
fs) -> [TypeFilter] -> m [TypeFilter]
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeFilter]
fs
Maybe [TypeFilter]
_ -> String -> m [TypeFilter]
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m [TypeFilter]) -> String -> m [TypeFilter]
forall a b. (a -> b) -> a -> b
$ String
"Param " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not exist"
let ts :: [GeneralInstance]
ts = (TypeFilter -> GeneralInstance)
-> [TypeFilter] -> [GeneralInstance]
forall a b. (a -> b) -> [a] -> [b]
map TypeFilter -> GeneralInstance
tfType ([TypeFilter] -> [GeneralInstance])
-> [TypeFilter] -> [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ (TypeFilter -> Bool) -> [TypeFilter] -> [TypeFilter]
forall a. (a -> Bool) -> [a] -> [a]
filter TypeFilter -> Bool
isRequiresFilter [TypeFilter]
fs
let ds :: [DefinesInstance]
ds = (TypeFilter -> DefinesInstance)
-> [TypeFilter] -> [DefinesInstance]
forall a b. (a -> b) -> [a] -> [b]
map TypeFilter -> DefinesInstance
dfType ([TypeFilter] -> [DefinesInstance])
-> [TypeFilter] -> [DefinesInstance]
forall a b. (a -> b) -> a -> b
$ (TypeFilter -> Bool) -> [TypeFilter] -> [TypeFilter]
forall a. (a -> Bool) -> [a] -> [a]
filter TypeFilter -> Bool
isDefinesFilter [TypeFilter]
fs
[m (ScopedFunction c)] -> m (ScopedFunction c)
forall (m :: * -> *) (f :: * -> *) a.
(CompileErrorM m, Foldable f) =>
f (m a) -> m a
collectFirstM ((GeneralInstance -> m (ScopedFunction c))
-> [GeneralInstance] -> [m (ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe GeneralInstance -> m (ScopedFunction c)
getFunction (Maybe GeneralInstance -> m (ScopedFunction c))
-> (GeneralInstance -> Maybe GeneralInstance)
-> GeneralInstance
-> m (ScopedFunction c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just) [GeneralInstance]
ts [m (ScopedFunction c)]
-> [m (ScopedFunction c)] -> [m (ScopedFunction c)]
forall a. [a] -> [a] -> [a]
++ (DefinesInstance -> m (ScopedFunction c))
-> [DefinesInstance] -> [m (ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map DefinesInstance -> m (ScopedFunction c)
forall (m :: * -> *).
CompileErrorM m =>
DefinesInstance -> m (ScopedFunction c)
checkDefine [DefinesInstance]
ds) m (ScopedFunction c) -> String -> m (ScopedFunction c)
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<!!
String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not available for param " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
getFromSingle (JustTypeInstance TypeInstance
t2)
| TypeInstance -> CategoryName
tiName TypeInstance
t2 CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx =
CategoryName
-> Positional ParamName
-> Positional GeneralInstance
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
forall (m :: * -> *) c.
(CompileErrorM m, Show c) =>
CategoryName
-> Positional ParamName
-> Positional GeneralInstance
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction (TypeInstance -> CategoryName
tiName TypeInstance
t2) ((ValueParam c -> ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam (Positional (ValueParam c) -> Positional ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx) (TypeInstance -> Positional GeneralInstance
tiParams TypeInstance
t2) (Maybe (ScopedFunction c) -> m (ScopedFunction c))
-> Maybe (ScopedFunction c) -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ FunctionName
n FunctionName
-> Map FunctionName (ScopedFunction c) -> Maybe (ScopedFunction c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx
| Bool
otherwise = do
([c]
_,AnyCategory c
ca) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getCategory (ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx) ([c]
c,TypeInstance -> CategoryName
tiName TypeInstance
t2)
let params :: Positional ParamName
params = [ParamName] -> Positional ParamName
forall a. [a] -> Positional a
Positional ([ParamName] -> Positional ParamName)
-> [ParamName] -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ (ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
ca
let fa :: Map FunctionName (ScopedFunction c)
fa = [(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
ca
CategoryName
-> Positional ParamName
-> Positional GeneralInstance
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
forall (m :: * -> *) c.
(CompileErrorM m, Show c) =>
CategoryName
-> Positional ParamName
-> Positional GeneralInstance
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction (TypeInstance -> CategoryName
tiName TypeInstance
t2) Positional ParamName
params (TypeInstance -> Positional GeneralInstance
tiParams TypeInstance
t2) (Maybe (ScopedFunction c) -> m (ScopedFunction c))
-> Maybe (ScopedFunction c) -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ 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
getFromSingle TypeInstanceOrParam
_ = String -> m (ScopedFunction c)
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m (ScopedFunction c)) -> String -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe GeneralInstance -> String
forall a. Show a => a -> String
show Maybe GeneralInstance
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" contains unresolved types"
checkDefine :: DefinesInstance -> m (ScopedFunction c)
checkDefine DefinesInstance
t2 = do
([c]
_,AnyCategory c
ca) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getCategory (ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx) ([c]
c,DefinesInstance -> CategoryName
diName DefinesInstance
t2)
let params :: Positional ParamName
params = [ParamName] -> Positional ParamName
forall a. [a] -> Positional a
Positional ([ParamName] -> Positional ParamName)
-> [ParamName] -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ (ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
ca
let fa :: Map FunctionName (ScopedFunction c)
fa = [(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
ca
CategoryName
-> Positional ParamName
-> Positional GeneralInstance
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
forall (m :: * -> *) c.
(CompileErrorM m, Show c) =>
CategoryName
-> Positional ParamName
-> Positional GeneralInstance
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction (DefinesInstance -> CategoryName
diName DefinesInstance
t2) Positional ParamName
params (DefinesInstance -> Positional GeneralInstance
diParams DefinesInstance
t2) (Maybe (ScopedFunction c) -> m (ScopedFunction c))
-> Maybe (ScopedFunction c) -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ 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
subAndCheckFunction :: CategoryName
-> Positional ParamName
-> Positional GeneralInstance
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction CategoryName
t2 Positional ParamName
ps1 Positional GeneralInstance
ps2 (Just ScopedFunction c
f) = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx Bool -> Bool -> Bool
&& CategoryName
t2 CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" disallowed during initialization" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t2 String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" is a category function" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
[(ParamName, GeneralInstance)]
paired <- (ParamName -> GeneralInstance -> m (ParamName, GeneralInstance))
-> Positional ParamName
-> Positional GeneralInstance
-> m [(ParamName, GeneralInstance)]
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs ParamName -> GeneralInstance -> m (ParamName, GeneralInstance)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair Positional ParamName
ps1 Positional GeneralInstance
ps2 m [(ParamName, GeneralInstance)]
-> String -> m [(ParamName, GeneralInstance)]
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<??
String
"In external function call at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
let assigned :: Map ParamName GeneralInstance
assigned = [(ParamName, GeneralInstance)] -> Map ParamName GeneralInstance
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ParamName, GeneralInstance)]
paired
Map ParamName GeneralInstance
-> ScopedFunction c -> m (ScopedFunction c)
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
Map ParamName GeneralInstance
-> ScopedFunction c -> m (ScopedFunction c)
uncheckedSubFunction Map ParamName GeneralInstance
assigned ScopedFunction c
f
subAndCheckFunction CategoryName
t2 Positional ParamName
_ Positional GeneralInstance
_ Maybe (ScopedFunction c)
_ =
String -> m (ScopedFunction c)
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m (ScopedFunction c)) -> String -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t2 String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" does not have a type or value function named " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
[c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
ccCheckValueInit :: ProcedureContext c
-> [c]
-> TypeInstance
-> ExpressionType
-> Positional GeneralInstance
-> m ()
ccCheckValueInit ProcedureContext c
ctx [c]
c (TypeInstance CategoryName
t Positional GeneralInstance
as) ExpressionType
ts Positional GeneralInstance
ps
| CategoryName
t CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
/= ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx =
String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot initialize values from " String -> String -> String
forall a. [a] -> [a] -> [a]
++
CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
| Bool
otherwise = String
"In initialization at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String -> m () -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
??> do
let t' :: TypeInstance
t' = CategoryName -> Positional GeneralInstance -> TypeInstance
TypeInstance (ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx) Positional GeneralInstance
as
AnyTypeResolver
r <- ProcedureContext c -> m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m AnyTypeResolver
ccResolver ProcedureContext c
ctx
ParamFilters
allFilters <- ProcedureContext c -> m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m ParamFilters
ccAllFilters ProcedureContext c
ctx
Map ParamName GeneralInstance
pa <- ([(ParamName, GeneralInstance)] -> Map ParamName GeneralInstance)
-> m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ParamName, GeneralInstance)] -> Map ParamName GeneralInstance
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance))
-> m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance)
forall a b. (a -> b) -> a -> b
$ (ParamName -> GeneralInstance -> m (ParamName, GeneralInstance))
-> Positional ParamName
-> Positional GeneralInstance
-> m [(ParamName, GeneralInstance)]
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs ParamName -> GeneralInstance -> m (ParamName, GeneralInstance)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair ((ValueParam c -> ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam (Positional (ValueParam c) -> Positional ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx) Positional GeneralInstance
as
Map ParamName GeneralInstance
pa2 <- ([(ParamName, GeneralInstance)] -> Map ParamName GeneralInstance)
-> m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ParamName, GeneralInstance)] -> Map ParamName GeneralInstance
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance))
-> m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance)
forall a b. (a -> b) -> a -> b
$ (ParamName -> GeneralInstance -> m (ParamName, GeneralInstance))
-> Positional ParamName
-> Positional GeneralInstance
-> m [(ParamName, GeneralInstance)]
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs ParamName -> GeneralInstance -> m (ParamName, GeneralInstance)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair ((ValueParam c -> ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam (Positional (ValueParam c) -> Positional ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx) Positional GeneralInstance
ps
let pa' :: Map ParamName GeneralInstance
pa' = Map ParamName GeneralInstance
-> Map ParamName GeneralInstance -> Map ParamName GeneralInstance
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map ParamName GeneralInstance
pa Map ParamName GeneralInstance
pa2
AnyTypeResolver -> ParamFilters -> TypeInstance -> m ()
forall (m :: * -> *) r.
(CompileErrorM m, TypeResolver r) =>
r -> ParamFilters -> TypeInstance -> m ()
validateTypeInstance AnyTypeResolver
r ParamFilters
allFilters TypeInstance
t'
let mapped :: ParamFilters
mapped = ([TypeFilter] -> [TypeFilter] -> [TypeFilter])
-> [(ParamName, [TypeFilter])] -> ParamFilters
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [TypeFilter] -> [TypeFilter] -> [TypeFilter]
forall a. [a] -> [a] -> [a]
(++) ([(ParamName, [TypeFilter])] -> ParamFilters)
-> [(ParamName, [TypeFilter])] -> ParamFilters
forall a b. (a -> b) -> a -> b
$ (ParamFilter c -> (ParamName, [TypeFilter]))
-> [ParamFilter c] -> [(ParamName, [TypeFilter])]
forall a b. (a -> b) -> [a] -> [b]
map (\ParamFilter c
f -> (ParamFilter c -> ParamName
forall c. ParamFilter c -> ParamName
pfParam ParamFilter c
f,[ParamFilter c -> TypeFilter
forall c. ParamFilter c -> TypeFilter
pfFilter ParamFilter c
f])) (ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx)
let positional :: [[TypeFilter]]
positional = (ParamName -> [TypeFilter]) -> [ParamName] -> [[TypeFilter]]
forall a b. (a -> b) -> [a] -> [b]
map (ParamFilters -> ParamName -> [TypeFilter]
forall k a. Ord k => Map k [a] -> k -> [a]
getFilters ParamFilters
mapped) ((ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues (Positional (ValueParam c) -> [ValueParam c])
-> Positional (ValueParam c) -> [ValueParam c]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx)
Map ParamName GeneralInstance
assigned <- ([(ParamName, GeneralInstance)] -> Map ParamName GeneralInstance)
-> m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ParamName, GeneralInstance)] -> Map ParamName GeneralInstance
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance))
-> m [(ParamName, GeneralInstance)]
-> m (Map ParamName GeneralInstance)
forall a b. (a -> b) -> a -> b
$ (ParamName -> GeneralInstance -> m (ParamName, GeneralInstance))
-> Positional ParamName
-> Positional GeneralInstance
-> m [(ParamName, GeneralInstance)]
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs ParamName -> GeneralInstance -> m (ParamName, GeneralInstance)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair ((ValueParam c -> ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam (Positional (ValueParam c) -> Positional ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx) Positional GeneralInstance
ps
Positional [TypeFilter]
subbed <- ([[TypeFilter]] -> Positional [TypeFilter])
-> m [[TypeFilter]] -> m (Positional [TypeFilter])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[TypeFilter]] -> Positional [TypeFilter]
forall a. [a] -> Positional a
Positional (m [[TypeFilter]] -> m (Positional [TypeFilter]))
-> m [[TypeFilter]] -> m (Positional [TypeFilter])
forall a b. (a -> b) -> a -> b
$ ([TypeFilter] -> m [TypeFilter])
-> [[TypeFilter]] -> m [[TypeFilter]]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Map ParamName GeneralInstance -> [TypeFilter] -> m [TypeFilter]
forall (m :: * -> *).
CompileErrorM m =>
Map ParamName GeneralInstance -> [TypeFilter] -> m [TypeFilter]
assignFilters Map ParamName GeneralInstance
assigned) [[TypeFilter]]
positional
(GeneralInstance -> [TypeFilter] -> m ())
-> Positional GeneralInstance -> Positional [TypeFilter] -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ (AnyTypeResolver
-> ParamFilters -> GeneralInstance -> [TypeFilter] -> m ()
forall (m :: * -> *) r.
(CompileErrorM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> [TypeFilter] -> m ()
validateAssignment AnyTypeResolver
r ParamFilters
allFilters) Positional GeneralInstance
ps Positional [TypeFilter]
subbed
Positional (MemberValue c)
ms <- ([MemberValue c] -> Positional (MemberValue c))
-> m [MemberValue c] -> m (Positional (MemberValue c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MemberValue c] -> Positional (MemberValue c)
forall a. [a] -> Positional a
Positional (m [MemberValue c] -> m (Positional (MemberValue c)))
-> m [MemberValue c] -> m (Positional (MemberValue c))
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> m (MemberValue c))
-> [DefinedMember c] -> m [MemberValue c]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Map ParamName GeneralInstance
-> DefinedMember c -> m (MemberValue c)
forall (m :: * -> *) c.
CompileErrorM m =>
Map ParamName GeneralInstance
-> DefinedMember c -> m (MemberValue c)
subSingle Map ParamName GeneralInstance
pa') (ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx)
(MemberValue c -> (Int, ValueType) -> m ())
-> Positional (MemberValue c)
-> Positional (Int, ValueType)
-> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ (AnyTypeResolver
-> ParamFilters -> MemberValue c -> (Int, ValueType) -> m ()
forall (m :: * -> *) r a a.
(CompileErrorM m, TypeResolver r, Show a, Show a) =>
r -> ParamFilters -> MemberValue a -> (a, ValueType) -> m ()
checkInit AnyTypeResolver
r ParamFilters
allFilters) Positional (MemberValue c)
ms ([(Int, ValueType)] -> Positional (Int, ValueType)
forall a. [a] -> Positional a
Positional ([(Int, ValueType)] -> Positional (Int, ValueType))
-> [(Int, ValueType)] -> Positional (Int, ValueType)
forall a b. (a -> b) -> a -> b
$ [Int] -> [ValueType] -> [(Int, ValueType)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
1..] :: [Int]) ([ValueType] -> [(Int, ValueType)])
-> [ValueType] -> [(Int, ValueType)]
forall a b. (a -> b) -> a -> b
$ ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues ExpressionType
ts)
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
getFilters :: Map k [a] -> k -> [a]
getFilters Map k [a]
fm k
n =
case k
n k -> Map k [a] -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k [a]
fm of
(Just [a]
fs) -> [a]
fs
Maybe [a]
_ -> []
assignFilters :: Map ParamName GeneralInstance -> [TypeFilter] -> m [TypeFilter]
assignFilters Map ParamName GeneralInstance
fm [TypeFilter]
fs = do
(TypeFilter -> m TypeFilter) -> [TypeFilter] -> m [TypeFilter]
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM ((ParamName -> m GeneralInstance) -> TypeFilter -> m TypeFilter
forall (m :: * -> *).
CompileErrorM m =>
(ParamName -> m GeneralInstance) -> TypeFilter -> m TypeFilter
uncheckedSubFilter ((ParamName -> m GeneralInstance) -> TypeFilter -> m TypeFilter)
-> (ParamName -> m GeneralInstance) -> TypeFilter -> m TypeFilter
forall a b. (a -> b) -> a -> b
$ Map ParamName GeneralInstance -> ParamName -> m GeneralInstance
forall (m :: * -> *).
CompileErrorM m =>
Map ParamName GeneralInstance -> ParamName -> m GeneralInstance
getValueForParam Map ParamName GeneralInstance
fm) [TypeFilter]
fs
checkInit :: r -> ParamFilters -> MemberValue a -> (a, ValueType) -> m ()
checkInit r
r ParamFilters
fa (MemberValue [a]
c2 VariableName
n ValueType
t0) (a
i,ValueType
t1) = do
r -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CompileErrorM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment r
r ParamFilters
fa ValueType
t1 ValueType
t0 m () -> String -> m ()
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<??
String
"In initializer " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c2
subSingle :: Map ParamName GeneralInstance
-> DefinedMember c -> m (MemberValue c)
subSingle Map ParamName GeneralInstance
pa (DefinedMember [c]
c2 SymbolScope
_ ValueType
t2 VariableName
n Maybe (Expression c)
_) = do
ValueType
t2' <- (ParamName -> m GeneralInstance) -> ValueType -> m ValueType
forall (m :: * -> *).
CompileErrorM m =>
(ParamName -> m GeneralInstance) -> ValueType -> m ValueType
uncheckedSubValueType (Map ParamName GeneralInstance -> ParamName -> m GeneralInstance
forall (m :: * -> *).
CompileErrorM m =>
Map ParamName GeneralInstance -> ParamName -> m GeneralInstance
getValueForParam Map ParamName GeneralInstance
pa) ValueType
t2
MemberValue c -> m (MemberValue c)
forall (m :: * -> *) a. Monad m => a -> m a
return (MemberValue c -> m (MemberValue c))
-> MemberValue c -> m (MemberValue c)
forall a b. (a -> b) -> a -> b
$ [c] -> VariableName -> ValueType -> MemberValue c
forall c. [c] -> VariableName -> ValueType -> MemberValue c
MemberValue [c]
c2 VariableName
n ValueType
t2'
ccGetVariable :: ProcedureContext c -> [c] -> VariableName -> m (VariableValue c)
ccGetVariable ProcedureContext c
ctx [c]
c VariableName
n =
case VariableName
n VariableName
-> Map VariableName (VariableValue c) -> Maybe (VariableValue c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx of
(Just VariableValue c
v) -> VariableValue c -> m (VariableValue c)
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue c
v
Maybe (VariableValue c)
_ -> String -> m (VariableValue c)
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m (VariableValue c)) -> String -> m (VariableValue c)
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not defined" String -> String -> String
forall a. [a] -> [a] -> [a]
++
[c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
ccAddVariable :: ProcedureContext c
-> [c] -> VariableName -> VariableValue c -> m (ProcedureContext c)
ccAddVariable ProcedureContext c
ctx [c]
c VariableName
n VariableValue c
t = do
case VariableName
n VariableName
-> Map VariableName (VariableValue c) -> Maybe (VariableValue c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx of
Maybe (VariableValue c)
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Just VariableValue c
v) -> String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
[c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" is already defined: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableValue c -> String
forall a. Show a => a -> String
show VariableValue c
v
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = 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 VariableName
n VariableValue c
t (ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx),
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccCheckVariableInit :: ProcedureContext c -> [c] -> VariableName -> m ()
ccCheckVariableInit ProcedureContext c
ctx [c]
c VariableName
n =
case ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx of
ValidateNames Positional VariableName
_ Positional (PassedValue c)
_ Map VariableName (PassedValue c)
na -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VariableName
n VariableName -> Map VariableName (PassedValue c) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map VariableName (PassedValue c)
na) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Named return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" might not be initialized" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
ReturnValidation c
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ccWrite :: ProcedureContext c -> [String] -> m (ProcedureContext c)
ccWrite ProcedureContext c
ctx [String]
ss = ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$
ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ss,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccGetOutput :: ProcedureContext c -> m [String]
ccGetOutput = [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String])
-> (ProcedureContext c -> [String])
-> ProcedureContext c
-> m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput
ccClearOutput :: ProcedureContext c -> m (ProcedureContext c)
ccClearOutput ProcedureContext c
ctx = ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = [],
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccUpdateAssigned :: ProcedureContext c -> VariableName -> m (ProcedureContext c)
ccUpdateAssigned ProcedureContext c
ctx VariableName
n = ReturnValidation c -> m (ProcedureContext c)
forall (m :: * -> *).
Monad m =>
ReturnValidation c -> m (ProcedureContext c)
update (ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx) where
update :: ReturnValidation c -> m (ProcedureContext c)
update (ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts Map VariableName (PassedValue c)
ra) = ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts (Map VariableName (PassedValue c) -> ReturnValidation c)
-> Map VariableName (PassedValue c) -> ReturnValidation c
forall a b. (a -> b) -> a -> b
$ VariableName
-> Map VariableName (PassedValue c)
-> Map VariableName (PassedValue c)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete VariableName
n Map VariableName (PassedValue c)
ra,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
update ReturnValidation c
_ = ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return ProcedureContext c
ctx
ccInheritReturns :: ProcedureContext c
-> [ProcedureContext c] -> m (ProcedureContext c)
ccInheritReturns ProcedureContext c
ctx [ProcedureContext c]
cs = ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ReturnValidation c
returns,
pcJumpType :: JumpType
pcJumpType = JumpType
jump,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
where
(ReturnValidation c
returns,JumpType
jump) = (ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType) -> (ReturnValidation c, JumpType)
forall a c.
Ord a =>
(ReturnValidation c, a)
-> (ReturnValidation c, a) -> (ReturnValidation c, a)
combineSeries (ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx) (ReturnValidation c, JumpType)
inherited
combineSeries :: (ReturnValidation c, a)
-> (ReturnValidation c, a) -> (ReturnValidation c, a)
combineSeries (r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),a
j1) (ReturnValidation c
_,a
j2) = (ReturnValidation c
r,a -> a -> a
forall a. Ord a => a -> a -> a
max a
j1 a
j2)
combineSeries (ReturnValidation c
_,a
j1) (r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),a
j2) = (ReturnValidation c
r,a -> a -> a
forall a. Ord a => a -> a -> a
max a
j1 a
j2)
combineSeries (ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts Map VariableName (PassedValue c)
ra1,a
j1) (ValidateNames Positional VariableName
_ Positional (PassedValue c)
_ Map VariableName (PassedValue c)
ra2,a
j2) = (Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts (Map VariableName (PassedValue c) -> ReturnValidation c)
-> Map VariableName (PassedValue c) -> ReturnValidation c
forall a b. (a -> b) -> a -> b
$ Map VariableName (PassedValue c)
-> Map VariableName (PassedValue c)
-> Map VariableName (PassedValue c)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map VariableName (PassedValue c)
ra1 Map VariableName (PassedValue c)
ra2,a -> a -> a
forall a. Ord a => a -> a -> a
max a
j1 a
j2)
inherited :: (ReturnValidation c, JumpType)
inherited = ((ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType))
-> (ReturnValidation c, JumpType)
-> [(ReturnValidation c, JumpType)]
-> (ReturnValidation c, JumpType)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType) -> (ReturnValidation c, JumpType)
forall c.
(ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType) -> (ReturnValidation c, JumpType)
combineParallel (Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
ValidateNames ([VariableName] -> Positional VariableName
forall a. [a] -> Positional a
Positional []) ([PassedValue c] -> Positional (PassedValue c)
forall a. [a] -> Positional a
Positional []) Map VariableName (PassedValue c)
forall k a. Map k a
Map.empty,JumpType
JumpMax) ([(ReturnValidation c, JumpType)]
-> (ReturnValidation c, JumpType))
-> [(ReturnValidation c, JumpType)]
-> (ReturnValidation c, JumpType)
forall a b. (a -> b) -> a -> b
$ [ReturnValidation c]
-> [JumpType] -> [(ReturnValidation c, JumpType)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((ProcedureContext c -> ReturnValidation c)
-> [ProcedureContext c] -> [ReturnValidation c]
forall a b. (a -> b) -> [a] -> [b]
map ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns [ProcedureContext c]
cs) ((ProcedureContext c -> JumpType)
-> [ProcedureContext c] -> [JumpType]
forall a b. (a -> b) -> [a] -> [b]
map ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType [ProcedureContext c]
cs)
combineParallel :: (ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType) -> (ReturnValidation c, JumpType)
combineParallel (ReturnValidation c
_,JumpType
j1) (ReturnValidation c
r,JumpType
j2)
| (if ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx then JumpType
j1 JumpType -> JumpType -> Bool
forall a. Ord a => a -> a -> Bool
> JumpType
JumpReturn else JumpType
j1 JumpType -> JumpType -> Bool
forall a. Ord a => a -> a -> Bool
> JumpType
NextStatement) = (ReturnValidation c
r,JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
combineParallel (ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts Map VariableName (PassedValue c)
ra1,JumpType
j1) (ValidateNames Positional VariableName
_ Positional (PassedValue c)
_ Map VariableName (PassedValue c)
ra2,JumpType
j2) = (Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts (Map VariableName (PassedValue c) -> ReturnValidation c)
-> Map VariableName (PassedValue c) -> ReturnValidation c
forall a b. (a -> b) -> a -> b
$ Map VariableName (PassedValue c)
-> Map VariableName (PassedValue c)
-> Map VariableName (PassedValue c)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map VariableName (PassedValue c)
ra1 Map VariableName (PassedValue c)
ra2,JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
combineParallel (r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),JumpType
j1) (ReturnValidation c
_,JumpType
j2) = (ReturnValidation c
r,JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
combineParallel (ReturnValidation c
_,JumpType
j1) (r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),JumpType
j2) = (ReturnValidation c
r,JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
ccRegisterReturn :: ProcedureContext c
-> [c] -> Maybe ExpressionType -> m (ProcedureContext c)
ccRegisterReturn ProcedureContext c
ctx [c]
c Maybe ExpressionType
vs = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Explicit return at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not allowed in cleanup"
ReturnValidation c
returns <- ReturnValidation c -> m (ReturnValidation c)
forall (m :: * -> *) c.
(CompileErrorM m, Show c) =>
ReturnValidation c -> m (ReturnValidation c)
check (ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx)
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ReturnValidation c
returns,
pcJumpType :: JumpType
pcJumpType = JumpType
JumpReturn,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
where
check :: ReturnValidation c -> m (ReturnValidation c)
check (ValidatePositions Positional (PassedValue c)
rs) = do
let vs' :: ExpressionType
vs' = case Maybe ExpressionType
vs of
Maybe ExpressionType
Nothing -> [ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional []
Just ExpressionType
vs2 -> ExpressionType
vs2
(ValueType -> ValueType -> m (ValueType, ValueType))
-> ExpressionType -> ExpressionType -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ ValueType -> ValueType -> m (ValueType, ValueType)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair ((PassedValue c -> ValueType)
-> Positional (PassedValue c) -> ExpressionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType Positional (PassedValue c)
rs) ExpressionType
vs' m () -> String -> m ()
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<??
String
"In procedure return at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
(PassedValue c -> (Int, ValueType) -> m ())
-> Positional (PassedValue c)
-> Positional (Int, ValueType)
-> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ PassedValue c -> (Int, ValueType) -> m ()
forall (m :: * -> *) c a.
(CompileErrorM m, Show c, Show a) =>
PassedValue c -> (a, ValueType) -> m ()
checkReturnType Positional (PassedValue c)
rs ([(Int, ValueType)] -> Positional (Int, ValueType)
forall a. [a] -> Positional a
Positional ([(Int, ValueType)] -> Positional (Int, ValueType))
-> [(Int, ValueType)] -> Positional (Int, ValueType)
forall a b. (a -> b) -> a -> b
$ [Int] -> [ValueType] -> [(Int, ValueType)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([ValueType] -> [(Int, ValueType)])
-> [ValueType] -> [(Int, ValueType)]
forall a b. (a -> b) -> a -> b
$ ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues ExpressionType
vs') m () -> String -> m ()
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<??
String
"In procedure return at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
ReturnValidation c -> m (ReturnValidation c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Positional (PassedValue c) -> ReturnValidation c
forall c. Positional (PassedValue c) -> ReturnValidation c
ValidatePositions Positional (PassedValue c)
rs)
where
checkReturnType :: PassedValue c -> (a, ValueType) -> m ()
checkReturnType ta0 :: PassedValue c
ta0@(PassedValue [c]
_ ValueType
t0) (a
n,ValueType
t) = do
AnyTypeResolver
r <- ProcedureContext c -> m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m AnyTypeResolver
ccResolver ProcedureContext c
ctx
ParamFilters
pa <- ProcedureContext c -> m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m ParamFilters
ccAllFilters ProcedureContext c
ctx
AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CompileErrorM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
pa ValueType
t ValueType
t0 m () -> String -> m ()
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<!!
String
"Cannot convert " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PassedValue c -> String
forall a. Show a => a -> String
show PassedValue c
ta0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in return " String -> String -> String
forall a. [a] -> [a] -> [a]
++
a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
check (ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts Map VariableName (PassedValue c)
ra) = do
case Maybe ExpressionType
vs of
Just ExpressionType
_ -> ReturnValidation c -> m (ReturnValidation c)
check (Positional (PassedValue c) -> ReturnValidation c
forall c. Positional (PassedValue c) -> ReturnValidation c
ValidatePositions Positional (PassedValue c)
ts) m (ReturnValidation c) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe ExpressionType
Nothing -> ((VariableName, PassedValue c) -> m Any)
-> [(VariableName, PassedValue c)] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (VariableName, PassedValue c) -> m Any
forall (m :: * -> *) a a a.
(CompileErrorM m, Show a, Show a) =>
(a, a) -> m a
alwaysError ([(VariableName, PassedValue c)] -> m ())
-> [(VariableName, PassedValue c)] -> m ()
forall a b. (a -> b) -> a -> b
$ Map VariableName (PassedValue c) -> [(VariableName, PassedValue c)]
forall k a. Map k a -> [(k, a)]
Map.toList Map VariableName (PassedValue c)
ra
ReturnValidation c -> m (ReturnValidation c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> Map VariableName (PassedValue c)
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts Map VariableName (PassedValue c)
forall k a. Map k a
Map.empty)
alwaysError :: (a, a) -> m a
alwaysError (a
n,a
t) = String -> m a
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Named return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
") might not have been set before return at " String -> String -> String
forall a. [a] -> [a] -> [a]
++
[c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
ccPrimNamedReturns :: ProcedureContext c -> m [ReturnVariable]
ccPrimNamedReturns = [ReturnVariable] -> m [ReturnVariable]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ReturnVariable] -> m [ReturnVariable])
-> (ProcedureContext c -> [ReturnVariable])
-> ProcedureContext c
-> m [ReturnVariable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed
ccIsUnreachable :: ProcedureContext c -> m Bool
ccIsUnreachable ProcedureContext c
ctx
| ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx JumpType -> JumpType -> Bool
forall a. Ord a => a -> a -> Bool
> JumpType
JumpReturn
| Bool
otherwise = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx JumpType -> JumpType -> Bool
forall a. Ord a => a -> a -> Bool
> JumpType
NextStatement
ccIsNamedReturns :: ProcedureContext c -> m Bool
ccIsNamedReturns = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool)
-> (ProcedureContext c -> Bool) -> ProcedureContext c -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed
ccSetJumpType :: ProcedureContext c -> JumpType -> m (ProcedureContext c)
ccSetJumpType ProcedureContext c
ctx JumpType
j =
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = JumpType
j,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccStartLoop :: ProcedureContext c -> LoopSetup [String] -> m (ProcedureContext c)
ccStartLoop ProcedureContext c
ctx LoopSetup [String]
l =
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = LoopSetup [String]
l,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = CleanupSetup (ProcedureContext c) [String]
forall a s. CleanupSetup a s
LoopBoundaryCleanupSetup (ProcedureContext c) [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]]
forall a. a -> [a] -> [a]
:(ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx),
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccGetLoop :: ProcedureContext c -> m (LoopSetup [String])
ccGetLoop = LoopSetup [String] -> m (LoopSetup [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (LoopSetup [String] -> m (LoopSetup [String]))
-> (ProcedureContext c -> LoopSetup [String])
-> ProcedureContext c
-> m (LoopSetup [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup
ccStartCleanup :: ProcedureContext c -> m (ProcedureContext c)
ccStartCleanup ProcedureContext c
ctx = do
let vars :: Map VariableName (VariableValue c)
vars = ReturnValidation c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall c c.
ReturnValidation c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
protectReturns (ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx) (ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx)
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = Map VariableName (VariableValue c)
vars,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = Bool
True,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
where
protectReturns :: ReturnValidation c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
protectReturns (ValidateNames Positional VariableName
ns Positional (PassedValue c)
_ Map VariableName (PassedValue c)
_) Map VariableName (VariableValue c)
vs = (VariableName
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c))
-> Map VariableName (VariableValue c)
-> [VariableName]
-> Map VariableName (VariableValue c)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr VariableName
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k c.
Ord k =>
k -> Map k (VariableValue c) -> Map k (VariableValue c)
protect Map VariableName (VariableValue c)
vs (Positional VariableName -> [VariableName]
forall a. Positional a -> [a]
pValues Positional VariableName
ns)
protectReturns ReturnValidation c
_ Map VariableName (VariableValue c)
vs = Map VariableName (VariableValue c)
vs
protect :: k -> Map k (VariableValue c) -> Map k (VariableValue c)
protect k
n Map k (VariableValue c)
vs =
case k
n k -> Map k (VariableValue c) -> Maybe (VariableValue c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (VariableValue c)
vs of
Just (VariableValue [c]
c s :: SymbolScope
s@SymbolScope
LocalScope ValueType
t Bool
_) -> k
-> VariableValue c
-> Map k (VariableValue c)
-> Map k (VariableValue c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
n ([c] -> SymbolScope -> ValueType -> Bool -> VariableValue c
forall c.
[c] -> SymbolScope -> ValueType -> Bool -> VariableValue c
VariableValue [c]
c SymbolScope
s ValueType
t Bool
False) Map k (VariableValue c)
vs
Maybe (VariableValue c)
_ -> Map k (VariableValue c)
vs
ccPushCleanup :: ProcedureContext c
-> CleanupSetup (ProcedureContext c) [String]
-> m (ProcedureContext c)
ccPushCleanup ProcedureContext c
ctx CleanupSetup (ProcedureContext c) [String]
cs =
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = CleanupSetup (ProcedureContext c) [String]
csCleanupSetup (ProcedureContext c) [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]]
forall a. a -> [a] -> [a]
:(ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx),
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccGetCleanup :: ProcedureContext c
-> JumpType -> m (CleanupSetup (ProcedureContext c) [String])
ccGetCleanup ProcedureContext c
ctx JumpType
j = CleanupSetup (ProcedureContext c) [String]
-> m (CleanupSetup (ProcedureContext c) [String])
forall (m :: * -> *) a. Monad m => a -> m a
return CleanupSetup (ProcedureContext c) [String]
combined where
combined :: CleanupSetup (ProcedureContext c) [String]
combined
| JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpReturn = [CleanupSetup (ProcedureContext c) [String]]
-> CleanupSetup (ProcedureContext c) [String]
forall a a. [CleanupSetup a [a]] -> CleanupSetup a [a]
combine ([CleanupSetup (ProcedureContext c) [String]]
-> CleanupSetup (ProcedureContext c) [String])
-> [CleanupSetup (ProcedureContext c) [String]]
-> CleanupSetup (ProcedureContext c) [String]
forall a b. (a -> b) -> a -> b
$ (CleanupSetup (ProcedureContext c) [String] -> Bool)
-> [CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (CleanupSetup (ProcedureContext c) [String] -> Bool)
-> CleanupSetup (ProcedureContext c) [String]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CleanupSetup (ProcedureContext c) [String] -> Bool
forall a s. CleanupSetup a s -> Bool
isLoopBoundary) ([CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]])
-> [CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx
| JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpBreak Bool -> Bool -> Bool
|| JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpReturn = [CleanupSetup (ProcedureContext c) [String]]
-> CleanupSetup (ProcedureContext c) [String]
forall a a. [CleanupSetup a [a]] -> CleanupSetup a [a]
combine ([CleanupSetup (ProcedureContext c) [String]]
-> CleanupSetup (ProcedureContext c) [String])
-> [CleanupSetup (ProcedureContext c) [String]]
-> CleanupSetup (ProcedureContext c) [String]
forall a b. (a -> b) -> a -> b
$ (CleanupSetup (ProcedureContext c) [String] -> Bool)
-> [CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool)
-> (CleanupSetup (ProcedureContext c) [String] -> Bool)
-> CleanupSetup (ProcedureContext c) [String]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CleanupSetup (ProcedureContext c) [String] -> Bool
forall a s. CleanupSetup a s -> Bool
isLoopBoundary) ([CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]])
-> [CleanupSetup (ProcedureContext c) [String]]
-> [CleanupSetup (ProcedureContext c) [String]]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx
| Bool
otherwise = [ProcedureContext c]
-> [String] -> CleanupSetup (ProcedureContext c) [String]
forall a s. [a] -> s -> CleanupSetup a s
CleanupSetup [] []
combine :: [CleanupSetup a [a]] -> CleanupSetup a [a]
combine [CleanupSetup a [a]]
cs = [a] -> [a] -> CleanupSetup a [a]
forall a s. [a] -> s -> CleanupSetup a s
CleanupSetup ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ (CleanupSetup a [a] -> [a]) -> [CleanupSetup a [a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map CleanupSetup a [a] -> [a]
forall a s. CleanupSetup a s -> [a]
csReturnContext [CleanupSetup a [a]]
cs) ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ (CleanupSetup a [a] -> [a]) -> [CleanupSetup a [a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map CleanupSetup a [a] -> [a]
forall a s. CleanupSetup a s -> s
csCleanup [CleanupSetup a [a]]
cs)
ccExprLookup :: ProcedureContext c -> [c] -> MacroName -> m (Expression c)
ccExprLookup ProcedureContext c
ctx [c]
c MacroName
n =
case MacroName
n MacroName -> ExprMap c -> Maybe (Expression c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx of
Maybe (Expression c)
Nothing -> String -> m (Expression c)
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m (Expression c)) -> String -> m (Expression c)
forall a b. (a -> b) -> a -> b
$ String
"Env expression " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MacroName -> String
forall a. Show a => a -> String
show MacroName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not defined" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
Just Expression c
e -> do
[(MacroName, [c])] -> [(MacroName, [c])] -> m ()
forall (m :: * -> *) a.
(CompileErrorM m, Show a) =>
[(MacroName, [a])] -> [(MacroName, [a])] -> m ()
checkReserved (ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx) [(MacroName
n,[c]
c)]
Expression c -> m (Expression c)
forall (m :: * -> *) a. Monad m => a -> m a
return Expression c
e
where
checkReserved :: [(MacroName, [a])] -> [(MacroName, [a])] -> m ()
checkReserved [] [(MacroName, [a])]
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkReserved (m :: (MacroName, [a])
m@(MacroName
n2,[a]
_):[(MacroName, [a])]
ms) [(MacroName, [a])]
rs
| MacroName
n2 MacroName -> MacroName -> Bool
forall a. Eq a => a -> a -> Bool
/= MacroName
n = [(MacroName, [a])] -> [(MacroName, [a])] -> m ()
checkReserved [(MacroName, [a])]
ms ((MacroName, [a])
m(MacroName, [a]) -> [(MacroName, [a])] -> [(MacroName, [a])]
forall a. a -> [a] -> [a]
:[(MacroName, [a])]
rs)
| Bool
otherwise = (((MacroName, [a]) -> m Any) -> [(MacroName, [a])] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (MacroName, [a]) -> m Any
forall (m :: * -> *) a a a.
(CompileErrorM m, Show a, Show a) =>
(a, [a]) -> m a
singleError ((MacroName, [a])
m(MacroName, [a]) -> [(MacroName, [a])] -> [(MacroName, [a])]
forall a. a -> [a] -> [a]
:[(MacroName, [a])]
rs)) m () -> String -> m ()
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<!!
String
"Expression macro " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MacroName -> String
forall a. Show a => a -> String
show MacroName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" references itself"
singleError :: (a, [a]) -> m a
singleError (a
n2,[a]
c2) = String -> m a
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
n2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" expanded at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c2
ccReserveExprMacro :: ProcedureContext c -> [c] -> MacroName -> m (ProcedureContext c)
ccReserveExprMacro ProcedureContext c
ctx [c]
c MacroName
n =
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ((MacroName
n,[c]
c)(MacroName, [c]) -> [(MacroName, [c])] -> [(MacroName, [c])]
forall a. a -> [a] -> [a]
:ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx),
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccReleaseExprMacro :: ProcedureContext c -> [c] -> MacroName -> m (ProcedureContext c)
ccReleaseExprMacro ProcedureContext c
ctx [c]
_ MacroName
n =
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ((MacroName, [c]) -> Bool)
-> [(MacroName, [c])] -> [(MacroName, [c])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((MacroName -> MacroName -> Bool
forall a. Eq a => a -> a -> Bool
/= MacroName
n) (MacroName -> Bool)
-> ((MacroName, [c]) -> MacroName) -> (MacroName, [c]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MacroName, [c]) -> MacroName
forall a b. (a, b) -> a
fst) ([(MacroName, [c])] -> [(MacroName, [c])])
-> [(MacroName, [c])] -> [(MacroName, [c])]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace ProcedureContext c
ctx
}
ccSetNoTrace :: ProcedureContext c -> Bool -> m (ProcedureContext c)
ccSetNoTrace ProcedureContext c
ctx Bool
t =
ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext :: forall c.
SymbolScope
-> CategoryName
-> Positional (ValueParam c)
-> Positional (ValueParam c)
-> [DefinedMember c]
-> CategoryMap c
-> ParamFilters
-> [ParamFilter c]
-> [ParamFilter c]
-> Map ParamName SymbolScope
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ReturnValidation c
-> JumpType
-> Bool
-> [ReturnVariable]
-> Set CategoryName
-> [String]
-> Bool
-> LoopSetup [String]
-> [CleanupSetup (ProcedureContext c) [String]]
-> Bool
-> ExprMap c
-> [(MacroName, [c])]
-> Bool
-> ProcedureContext c
ProcedureContext {
pcScope :: SymbolScope
pcScope = ProcedureContext c -> SymbolScope
forall c. ProcedureContext c -> SymbolScope
pcScope ProcedureContext c
ctx,
pcType :: CategoryName
pcType = ProcedureContext c -> CategoryName
forall c. ProcedureContext c -> CategoryName
pcType ProcedureContext c
ctx,
pcExtParams :: Positional (ValueParam c)
pcExtParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcExtParams ProcedureContext c
ctx,
pcIntParams :: Positional (ValueParam c)
pcIntParams = ProcedureContext c -> Positional (ValueParam c)
forall c. ProcedureContext c -> Positional (ValueParam c)
pcIntParams ProcedureContext c
ctx,
pcMembers :: [DefinedMember c]
pcMembers = ProcedureContext c -> [DefinedMember c]
forall c. ProcedureContext c -> [DefinedMember c]
pcMembers ProcedureContext c
ctx,
pcCategories :: CategoryMap c
pcCategories = ProcedureContext c -> CategoryMap c
forall c. ProcedureContext c -> CategoryMap c
pcCategories ProcedureContext c
ctx,
pcAllFilters :: ParamFilters
pcAllFilters = ProcedureContext c -> ParamFilters
forall c. ProcedureContext c -> ParamFilters
pcAllFilters ProcedureContext c
ctx,
pcExtFilters :: [ParamFilter c]
pcExtFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcExtFilters ProcedureContext c
ctx,
pcIntFilters :: [ParamFilter c]
pcIntFilters = ProcedureContext c -> [ParamFilter c]
forall c. ProcedureContext c -> [ParamFilter c]
pcIntFilters ProcedureContext c
ctx,
pcParamScopes :: Map ParamName SymbolScope
pcParamScopes = ProcedureContext c -> Map ParamName SymbolScope
forall c. ProcedureContext c -> Map ParamName SymbolScope
pcParamScopes ProcedureContext c
ctx,
pcFunctions :: Map FunctionName (ScopedFunction c)
pcFunctions = ProcedureContext c -> Map FunctionName (ScopedFunction c)
forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
pcFunctions ProcedureContext c
ctx,
pcVariables :: Map VariableName (VariableValue c)
pcVariables = ProcedureContext c -> Map VariableName (VariableValue c)
forall c. ProcedureContext c -> Map VariableName (VariableValue c)
pcVariables ProcedureContext c
ctx,
pcReturns :: ReturnValidation c
pcReturns = ProcedureContext c -> ReturnValidation c
forall c. ProcedureContext c -> ReturnValidation c
pcReturns ProcedureContext c
ctx,
pcJumpType :: JumpType
pcJumpType = ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx,
pcIsNamed :: Bool
pcIsNamed = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcIsNamed ProcedureContext c
ctx,
pcPrimNamed :: [ReturnVariable]
pcPrimNamed = ProcedureContext c -> [ReturnVariable]
forall c. ProcedureContext c -> [ReturnVariable]
pcPrimNamed ProcedureContext c
ctx,
pcRequiredTypes :: Set CategoryName
pcRequiredTypes = ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx,
pcOutput :: [String]
pcOutput = ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx,
pcDisallowInit :: Bool
pcDisallowInit = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcDisallowInit ProcedureContext c
ctx,
pcLoopSetup :: LoopSetup [String]
pcLoopSetup = ProcedureContext c -> LoopSetup [String]
forall c. ProcedureContext c -> LoopSetup [String]
pcLoopSetup ProcedureContext c
ctx,
pcCleanupSetup :: [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup = ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
forall c.
ProcedureContext c -> [CleanupSetup (ProcedureContext c) [String]]
pcCleanupSetup ProcedureContext c
ctx,
pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
pcExprMap :: ExprMap c
pcExprMap = ProcedureContext c -> ExprMap c
forall c. ProcedureContext c -> ExprMap c
pcExprMap ProcedureContext c
ctx,
pcReservedMacros :: [(MacroName, [c])]
pcReservedMacros = ProcedureContext c -> [(MacroName, [c])]
forall c. ProcedureContext c -> [(MacroName, [c])]
pcReservedMacros ProcedureContext c
ctx,
pcNoTrace :: Bool
pcNoTrace = Bool
t
}
ccGetNoTrace :: ProcedureContext c -> m Bool
ccGetNoTrace = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool)
-> (ProcedureContext c -> Bool) -> ProcedureContext c -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcNoTrace
updateReturnVariables :: (Show c, CompileErrorM m) =>
(Map.Map VariableName (VariableValue c)) ->
Positional (PassedValue c) -> ReturnValues c ->
m (Map.Map VariableName (VariableValue c))
updateReturnVariables :: Map VariableName (VariableValue c)
-> Positional (PassedValue c)
-> ReturnValues c
-> m (Map VariableName (VariableValue c))
updateReturnVariables Map VariableName (VariableValue c)
ma Positional (PassedValue c)
rs1 ReturnValues c
rs2 = m (Map VariableName (VariableValue c))
updated where
updated :: m (Map VariableName (VariableValue c))
updated
| ReturnValues c -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns ReturnValues c
rs2 = Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *) a. Monad m => a -> m a
return Map VariableName (VariableValue c)
ma
| Bool
otherwise = do
[(PassedValue c, OutputValue c)]
rs <- (PassedValue c
-> OutputValue c -> m (PassedValue c, OutputValue c))
-> Positional (PassedValue c)
-> Positional (OutputValue c)
-> m [(PassedValue c, OutputValue c)]
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs PassedValue c -> OutputValue c -> m (PassedValue c, OutputValue c)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair Positional (PassedValue c)
rs1 (ReturnValues c -> Positional (OutputValue c)
forall c. ReturnValues c -> Positional (OutputValue c)
nrNames ReturnValues c
rs2)
((PassedValue c, OutputValue c)
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c)))
-> m (Map VariableName (VariableValue c))
-> [(PassedValue c, OutputValue c)]
-> m (Map VariableName (VariableValue c))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (PassedValue c, OutputValue c)
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *) a a.
(CompileErrorM m, Show a, Show a) =>
(PassedValue a, OutputValue a)
-> m (Map VariableName (VariableValue a))
-> m (Map VariableName (VariableValue a))
update (Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *) a. Monad m => a -> m a
return Map VariableName (VariableValue c)
ma) [(PassedValue c, OutputValue c)]
rs where
update :: (PassedValue a, OutputValue a)
-> m (Map VariableName (VariableValue a))
-> m (Map VariableName (VariableValue a))
update (PassedValue [a]
c ValueType
t,OutputValue a
r) m (Map VariableName (VariableValue a))
va = do
Map VariableName (VariableValue a)
va' <- m (Map VariableName (VariableValue a))
va
case OutputValue a -> VariableName
forall c. OutputValue c -> VariableName
ovName OutputValue a
r VariableName
-> Map VariableName (VariableValue a) -> Maybe (VariableValue a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName (VariableValue a)
va' of
Maybe (VariableValue a)
Nothing -> Map VariableName (VariableValue a)
-> m (Map VariableName (VariableValue a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map VariableName (VariableValue a)
-> m (Map VariableName (VariableValue a)))
-> Map VariableName (VariableValue a)
-> m (Map VariableName (VariableValue a))
forall a b. (a -> b) -> a -> b
$ VariableName
-> VariableValue a
-> Map VariableName (VariableValue a)
-> Map VariableName (VariableValue a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (OutputValue a -> VariableName
forall c. OutputValue c -> VariableName
ovName OutputValue a
r) ([a] -> SymbolScope -> ValueType -> Bool -> VariableValue a
forall c.
[c] -> SymbolScope -> ValueType -> Bool -> VariableValue c
VariableValue [a]
c SymbolScope
LocalScope ValueType
t Bool
True) Map VariableName (VariableValue a)
va'
(Just VariableValue a
v) -> String -> m (Map VariableName (VariableValue a))
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m (Map VariableName (VariableValue a)))
-> String -> m (Map VariableName (VariableValue a))
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (OutputValue a -> VariableName
forall c. OutputValue c -> VariableName
ovName OutputValue a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
[a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (OutputValue a -> [a]
forall c. OutputValue c -> [c]
ovContext OutputValue a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" is already defined" String -> String -> String
forall a. [a] -> [a] -> [a]
++
[a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (VariableValue a -> [a]
forall c. VariableValue c -> [c]
vvContext VariableValue a
v)
updateArgVariables :: (Show c, CompileErrorM m) =>
(Map.Map VariableName (VariableValue c)) ->
Positional (PassedValue c) -> ArgValues c ->
m (Map.Map VariableName (VariableValue c))
updateArgVariables :: Map VariableName (VariableValue c)
-> Positional (PassedValue c)
-> ArgValues c
-> m (Map VariableName (VariableValue c))
updateArgVariables Map VariableName (VariableValue c)
ma Positional (PassedValue c)
as1 ArgValues c
as2 = do
[(PassedValue c, InputValue c)]
as <- (PassedValue c -> InputValue c -> m (PassedValue c, InputValue c))
-> Positional (PassedValue c)
-> Positional (InputValue c)
-> m [(PassedValue c, InputValue c)]
forall a b (m :: * -> *) c.
(Show a, Show b, CompileErrorM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs PassedValue c -> InputValue c -> m (PassedValue c, InputValue c)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair Positional (PassedValue c)
as1 (ArgValues c -> Positional (InputValue c)
forall c. ArgValues c -> Positional (InputValue c)
avNames ArgValues c
as2)
let as' :: [(PassedValue c, InputValue c)]
as' = ((PassedValue c, InputValue c) -> Bool)
-> [(PassedValue c, InputValue c)]
-> [(PassedValue c, InputValue c)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((PassedValue c, InputValue c) -> Bool)
-> (PassedValue c, InputValue c)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputValue c -> Bool
forall c. InputValue c -> Bool
isDiscardedInput (InputValue c -> Bool)
-> ((PassedValue c, InputValue c) -> InputValue c)
-> (PassedValue c, InputValue c)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PassedValue c, InputValue c) -> InputValue c
forall a b. (a, b) -> b
snd) [(PassedValue c, InputValue c)]
as
((PassedValue c, InputValue c)
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c)))
-> m (Map VariableName (VariableValue c))
-> [(PassedValue c, InputValue c)]
-> m (Map VariableName (VariableValue c))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (PassedValue c, InputValue c)
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *) a a.
(CompileErrorM m, Show a, Show a) =>
(PassedValue a, InputValue a)
-> m (Map VariableName (VariableValue a))
-> m (Map VariableName (VariableValue a))
update (Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *) a. Monad m => a -> m a
return Map VariableName (VariableValue c)
ma) [(PassedValue c, InputValue c)]
as' where
update :: (PassedValue a, InputValue a)
-> m (Map VariableName (VariableValue a))
-> m (Map VariableName (VariableValue a))
update (PassedValue [a]
c ValueType
t,InputValue a
a) m (Map VariableName (VariableValue a))
va = do
Map VariableName (VariableValue a)
va' <- m (Map VariableName (VariableValue a))
va
case InputValue a -> VariableName
forall c. InputValue c -> VariableName
ivName InputValue a
a VariableName
-> Map VariableName (VariableValue a) -> Maybe (VariableValue a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName (VariableValue a)
va' of
Maybe (VariableValue a)
Nothing -> Map VariableName (VariableValue a)
-> m (Map VariableName (VariableValue a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map VariableName (VariableValue a)
-> m (Map VariableName (VariableValue a)))
-> Map VariableName (VariableValue a)
-> m (Map VariableName (VariableValue a))
forall a b. (a -> b) -> a -> b
$ VariableName
-> VariableValue a
-> Map VariableName (VariableValue a)
-> Map VariableName (VariableValue a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (InputValue a -> VariableName
forall c. InputValue c -> VariableName
ivName InputValue a
a) ([a] -> SymbolScope -> ValueType -> Bool -> VariableValue a
forall c.
[c] -> SymbolScope -> ValueType -> Bool -> VariableValue c
VariableValue [a]
c SymbolScope
LocalScope ValueType
t Bool
False) Map VariableName (VariableValue a)
va'
(Just VariableValue a
v) -> String -> m (Map VariableName (VariableValue a))
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (String -> m (Map VariableName (VariableValue a)))
-> String -> m (Map VariableName (VariableValue a))
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (InputValue a -> VariableName
forall c. InputValue c -> VariableName
ivName InputValue a
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++
[a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (InputValue a -> [a]
forall c. InputValue c -> [c]
ivContext InputValue a
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" is already defined" String -> String -> String
forall a. [a] -> [a] -> [a]
++
[a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (VariableValue a -> [a]
forall c. VariableValue c -> [c]
vvContext VariableValue a
v)