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

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

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

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

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

{-# LANGUAGE Safe #-}

module CompilerCxx.CategoryContext (
  getContextForInit,
  getMainContext,
  getProcedureContext,
) where

import Prelude hiding (pi)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.GeneralType
import Base.Positional
import Compilation.CompilerState
import Compilation.ProcedureContext
import Compilation.ScopeContext
import CompilerCxx.Code (isStoredUnboxed)
import Types.DefinedCategory
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


getContextForInit :: (Show c, CollectErrorsM m) =>
  Bool -> CategoryMap c -> ExprMap c -> AnyCategory c -> DefinedCategory c ->
  SymbolScope -> m (ProcedureContext c)
getContextForInit :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Bool
-> CategoryMap c
-> ExprMap c
-> AnyCategory c
-> DefinedCategory c
-> SymbolScope
-> m (ProcedureContext c)
getContextForInit Bool
to CategoryMap c
tm ExprMap c
em AnyCategory c
t DefinedCategory c
d SymbolScope
s = do
  let ps :: Positional (ValueParam c)
ps = [ValueParam c] -> Positional (ValueParam c)
forall a. [a] -> Positional a
Positional ([ValueParam c] -> Positional (ValueParam c))
-> [ValueParam c] -> Positional (ValueParam c)
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
  -- NOTE: This is always ValueScope for initializer checks.
  let ms :: [DefinedMember c]
ms = (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) (SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) ([DefinedMember c] -> [DefinedMember c])
-> [DefinedMember c] -> [DefinedMember c]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d
  let pa :: [ParamFilter c]
pa = if SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope
              then []
              else AnyCategory c -> [ParamFilter c]
forall c. AnyCategory c -> [ParamFilter c]
getCategoryFilters AnyCategory c
t
  let sa :: Map ParamName SymbolScope
sa = [(ParamName, SymbolScope)] -> Map ParamName SymbolScope
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ParamName, SymbolScope)] -> Map ParamName SymbolScope)
-> [(ParamName, SymbolScope)] -> Map ParamName SymbolScope
forall a b. (a -> b) -> a -> b
$ [ParamName] -> [SymbolScope] -> [(ParamName, SymbolScope)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((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
t) (SymbolScope -> [SymbolScope]
forall a. a -> [a]
repeat SymbolScope
TypeScope)
  let r :: CategoryResolver c
r = CategoryMap c -> CategoryResolver c
forall c. CategoryMap c -> CategoryResolver c
CategoryResolver CategoryMap c
tm
  Map FunctionName (ScopedFunction c)
fa <- CategoryResolver c
-> AnyCategory c
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r
-> AnyCategory c
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
setInternalFunctions CategoryResolver c
r AnyCategory c
t (DefinedCategory c -> [ScopedFunction c]
forall c. DefinedCategory c -> [ScopedFunction c]
dcFunctions DefinedCategory c
d)
  ParamFilters
fm <- [ValueParam c] -> [ParamFilter c] -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
[ValueParam c] -> [ParamFilter c] -> m ParamFilters
getFilterMap (Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues Positional (ValueParam c)
ps) [ParamFilter c]
pa
  let typeInstance :: TypeInstance
typeInstance = CategoryName -> InstanceParams -> TypeInstance
TypeInstance (AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t) (InstanceParams -> TypeInstance) -> InstanceParams -> TypeInstance
forall a b. (a -> b) -> a -> b
$ (ValueParam c -> GeneralInstance)
-> Positional (ValueParam c) -> InstanceParams
forall a b. (a -> b) -> Positional a -> Positional b
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)
ps
  let builtin :: Map VariableName (VariableValue c)
builtin = (VariableValue c -> Bool)
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
LocalScope) (SymbolScope -> Bool)
-> (VariableValue c -> SymbolScope) -> VariableValue c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariableValue c -> SymbolScope
forall c. VariableValue c -> SymbolScope
vvScope) (Map VariableName (VariableValue c)
 -> Map VariableName (VariableValue c))
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall a b. (a -> b) -> a -> b
$ TypeInstance -> Map VariableName (VariableValue c)
forall c. TypeInstance -> Map VariableName (VariableValue c)
builtinVariables TypeInstance
typeInstance
  let readOnly :: Map VariableName [a]
readOnly = ([a] -> [a] -> [a])
-> [(VariableName, [a])] -> Map VariableName [a]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([(VariableName, [a])] -> Map VariableName [a])
-> [(VariableName, [a])] -> Map VariableName [a]
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> (VariableName, [a]))
-> [DefinedMember c] -> [(VariableName, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\DefinedMember c
m -> (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m,[])) ([DefinedMember c] -> [(VariableName, [a])])
-> [DefinedMember c] -> [(VariableName, [a])]
forall a b. (a -> b) -> a -> b
$ DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d
  Map VariableName (VariableValue c)
members <- Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
forall {a}. Map VariableName [a]
readOnly Map VariableName [c]
forall k a. Map k a
Map.empty ([DefinedMember c] -> m (Map VariableName (VariableValue c)))
-> [DefinedMember c] -> m (Map VariableName (VariableValue c))
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Ord a => a -> a -> Bool
<= SymbolScope
s) (SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) (DefinedCategory c -> [DefinedMember c]
forall c. DefinedCategory c -> [DefinedMember c]
dcMembers DefinedCategory c
d)
  ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
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 {
      _pcScope :: SymbolScope
_pcScope = SymbolScope
s,
      _pcType :: CategoryName
_pcType = AnyCategory c -> CategoryName
forall c. AnyCategory c -> CategoryName
getCategoryName AnyCategory c
t,
      _pcExtParams :: Positional (ValueParam c)
_pcExtParams = Positional (ValueParam c)
ps,
      _pcMembers :: [DefinedMember c]
_pcMembers = [DefinedMember c]
ms,
      _pcCategories :: CategoryMap c
_pcCategories = CategoryMap c
tm,
      _pcAllFilters :: ParamFilters
_pcAllFilters = ParamFilters
fm,
      _pcExtFilters :: [ParamFilter c]
_pcExtFilters = [ParamFilter c]
pa,
      _pcParamScopes :: Map ParamName SymbolScope
_pcParamScopes = Map ParamName SymbolScope
sa,
      _pcFunctions :: Map FunctionName (ScopedFunction c)
_pcFunctions = Map FunctionName (ScopedFunction c)
fa,
      _pcVariables :: Map VariableName (VariableValue c)
_pcVariables = Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map VariableName (VariableValue c)
forall {c}. Map VariableName (VariableValue c)
builtin Map VariableName (VariableValue c)
members,
      _pcReturns :: ReturnValidation c
_pcReturns = Positional (PassedValue c) -> ReturnValidation c
forall c. Positional (PassedValue c) -> ReturnValidation c
ValidatePositions ([PassedValue c] -> Positional (PassedValue c)
forall a. [a] -> Positional a
Positional []),
      _pcDeferred :: DeferVariable c
_pcDeferred = DeferVariable c
forall c. DeferVariable c
emptyDeferred,
      _pcJumpType :: JumpType
_pcJumpType = JumpType
NextStatement,
      _pcIsNamed :: Bool
_pcIsNamed = Bool
False,
      _pcPrimNamed :: [ReturnVariable]
_pcPrimNamed = [],
      _pcRequiredTypes :: Set CategoryName
_pcRequiredTypes = Set CategoryName
forall a. Set a
Set.empty,
      _pcOutput :: [String]
_pcOutput = [],
      _pcDisallowInit :: Bool
_pcDisallowInit = Bool
True,
      _pcLoopSetup :: LoopSetup [String]
_pcLoopSetup = LoopSetup [String]
forall s. LoopSetup s
NotInLoop,
      _pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
_pcCleanupBlocks = [],
      _pcInCleanup :: Bool
_pcInCleanup = Bool
False,
      _pcUsedVars :: [UsedVariable c]
_pcUsedVars = [],
      _pcExprMap :: ExprMap c
_pcExprMap = ExprMap c
em,
      _pcReservedMacros :: [(MacroName, [c])]
_pcReservedMacros = [],
      _pcNoTrace :: Bool
_pcNoTrace = Bool
False,
      _pcTestsOnly :: Bool
_pcTestsOnly = Bool
to,
      _pcTraces :: [String]
_pcTraces = [],
      _pcParentCall :: Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
_pcParentCall = Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
forall a. Maybe a
Nothing
    }

getProcedureContext :: (Show c, CollectErrorsM m) =>
  Bool -> ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (ProcedureContext c)
getProcedureContext :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Bool
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (ProcedureContext c)
getProcedureContext Bool
to (ScopeContext CategoryMap c
tm CategoryName
t Positional (ValueParam c)
ps [DefinedMember c]
ms [ParamFilter c]
pa Map FunctionName (ScopedFunction c)
fa Map VariableName (VariableValue c)
va ExprMap c
em)
                    ff :: ScopedFunction c
ff@(ScopedFunction [c]
_ FunctionName
_ CategoryName
_ SymbolScope
s FunctionVisibility c
_ Positional (PassedValue c, Maybe (CallArgLabel c))
as1 Positional (PassedValue c)
rs1 Positional (ValueParam c)
ps1 [ParamFilter c]
fs [ScopedFunction c]
_)
                    (ExecutableProcedure [c]
_ [PragmaProcedure c]
_ [c]
_ FunctionName
_ ArgValues c
as2 ReturnValues c
rs2 Procedure c
_) = do
  ReturnValidation c
rs' <- if ReturnValues c -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns ReturnValues c
rs2
            then ReturnValidation c -> m (ReturnValidation c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReturnValidation c -> m (ReturnValidation c))
-> ReturnValidation c -> m (ReturnValidation c)
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c) -> ReturnValidation c
forall c. Positional (PassedValue c) -> ReturnValidation c
ValidatePositions Positional (PassedValue c)
rs1
            else ([(VariableName, PassedValue c)] -> ReturnValidation c)
-> m [(VariableName, PassedValue c)] -> m (ReturnValidation c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
ValidateNames ((OutputValue c -> VariableName)
-> Positional (OutputValue c) -> Positional VariableName
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OutputValue c -> VariableName
forall c. OutputValue c -> VariableName
ovName (Positional (OutputValue c) -> Positional VariableName)
-> Positional (OutputValue c) -> Positional VariableName
forall a b. (a -> b) -> a -> b
$ ReturnValues c -> Positional (OutputValue c)
forall c. ReturnValues c -> Positional (OutputValue c)
nrNames ReturnValues c
rs2) Positional (PassedValue c)
rs1 (DeferVariable c -> ReturnValidation c)
-> ([(VariableName, PassedValue c)] -> DeferVariable c)
-> [(VariableName, PassedValue c)]
-> ReturnValidation c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VariableName, PassedValue c)
 -> DeferVariable c -> DeferVariable c)
-> DeferVariable c
-> [(VariableName, PassedValue c)]
-> DeferVariable c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((VariableName
 -> PassedValue c -> DeferVariable c -> DeferVariable c)
-> (VariableName, PassedValue c)
-> DeferVariable c
-> DeferVariable c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VariableName -> PassedValue c -> DeferVariable c -> DeferVariable c
forall c.
VariableName -> PassedValue c -> DeferVariable c -> DeferVariable c
addDeferred) DeferVariable c
forall c. DeferVariable c
emptyDeferred) (m [(VariableName, PassedValue c)] -> m (ReturnValidation c))
-> m [(VariableName, PassedValue c)] -> m (ReturnValidation c)
forall a b. (a -> b) -> a -> b
$ (PassedValue c -> OutputValue c -> m (VariableName, PassedValue c))
-> Positional (PassedValue c)
-> Positional (OutputValue c)
-> m [(VariableName, PassedValue c)]
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs PassedValue c -> OutputValue c -> m (VariableName, PassedValue c)
forall {m :: * -> *} {c}.
Monad m =>
PassedValue c -> OutputValue c -> m (VariableName, PassedValue c)
pairOutput Positional (PassedValue c)
rs1 (ReturnValues c -> Positional (OutputValue c)
forall c. ReturnValues c -> Positional (OutputValue c)
nrNames ReturnValues c
rs2)
  Map VariableName (VariableValue c)
va' <- Map VariableName (VariableValue c)
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> ArgValues c
-> m (Map VariableName (VariableValue c))
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName (VariableValue c)
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> ArgValues c
-> m (Map VariableName (VariableValue c))
updateArgVariables Map VariableName (VariableValue c)
va Positional (PassedValue c, Maybe (CallArgLabel c))
as1 ArgValues c
as2
  Map VariableName (VariableValue c)
va'' <- Map VariableName (VariableValue c)
-> Positional (PassedValue c)
-> ReturnValues c
-> m (Map VariableName (VariableValue c))
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName (VariableValue c)
-> Positional (PassedValue c)
-> ReturnValues c
-> m (Map VariableName (VariableValue c))
updateReturnVariables Map VariableName (VariableValue c)
va' Positional (PassedValue c)
rs1 ReturnValues c
rs2
  let pa' :: [ParamFilter c]
pa' = if SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope
               then [ParamFilter c]
fs
               else [ParamFilter c]
pa [ParamFilter c] -> [ParamFilter c] -> [ParamFilter c]
forall a. [a] -> [a] -> [a]
++ [ParamFilter c]
fs
  let localScopes :: Map ParamName SymbolScope
localScopes = [(ParamName, SymbolScope)] -> Map ParamName SymbolScope
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ParamName, SymbolScope)] -> Map ParamName SymbolScope)
-> [(ParamName, SymbolScope)] -> Map ParamName SymbolScope
forall a b. (a -> b) -> a -> b
$ [ParamName] -> [SymbolScope] -> [(ParamName, SymbolScope)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((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)
ps1) (SymbolScope -> [SymbolScope]
forall a. a -> [a]
repeat SymbolScope
LocalScope)
  let typeScopes :: Map ParamName SymbolScope
typeScopes = [(ParamName, SymbolScope)] -> Map ParamName SymbolScope
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ParamName, SymbolScope)] -> Map ParamName SymbolScope)
-> [(ParamName, SymbolScope)] -> Map ParamName SymbolScope
forall a b. (a -> b) -> a -> b
$ [ParamName] -> [SymbolScope] -> [(ParamName, SymbolScope)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((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)
ps) (SymbolScope -> [SymbolScope]
forall a. a -> [a]
repeat SymbolScope
TypeScope)
  let sa :: Map ParamName SymbolScope
sa = case SymbolScope
s of
                SymbolScope
CategoryScope -> Map ParamName SymbolScope
localScopes
                SymbolScope
TypeScope     -> Map ParamName SymbolScope
-> Map ParamName SymbolScope -> Map ParamName SymbolScope
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map ParamName SymbolScope
typeScopes Map ParamName SymbolScope
localScopes
                SymbolScope
ValueScope    -> Map ParamName SymbolScope
-> Map ParamName SymbolScope -> Map ParamName SymbolScope
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map ParamName SymbolScope
typeScopes Map ParamName SymbolScope
localScopes
                SymbolScope
_ -> Map ParamName SymbolScope
forall a. HasCallStack => a
undefined
  ParamFilters
localFilters <- ScopedFunction c -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
ScopedFunction c -> m ParamFilters
getFunctionFilterMap ScopedFunction c
ff
  ParamFilters
typeFilters <- [ValueParam c] -> [ParamFilter c] -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
[ValueParam c] -> [ParamFilter c] -> m ParamFilters
getFilterMap (Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues Positional (ValueParam c)
ps) [ParamFilter c]
pa
  let allFilters :: ParamFilters
allFilters = case SymbolScope
s of
                   SymbolScope
CategoryScope -> ParamFilters
localFilters
                   SymbolScope
TypeScope     -> ParamFilters -> ParamFilters -> ParamFilters
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ParamFilters
localFilters ParamFilters
typeFilters
                   SymbolScope
ValueScope    -> ParamFilters -> ParamFilters -> ParamFilters
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ParamFilters
localFilters ParamFilters
typeFilters
                   SymbolScope
_ -> ParamFilters
forall a. HasCallStack => a
undefined
  let ns0 :: [ReturnVariable]
ns0 = if ReturnValues c -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns ReturnValues c
rs2
               then []
               else (Int -> VariableName -> ValueType -> ReturnVariable)
-> [Int] -> [VariableName] -> [ValueType] -> [ReturnVariable]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> VariableName -> ValueType -> ReturnVariable
ReturnVariable [Int
0..] ((OutputValue c -> VariableName)
-> [OutputValue c] -> [VariableName]
forall a b. (a -> b) -> [a] -> [b]
map OutputValue c -> VariableName
forall c. OutputValue c -> VariableName
ovName ([OutputValue c] -> [VariableName])
-> [OutputValue c] -> [VariableName]
forall a b. (a -> b) -> a -> b
$ Positional (OutputValue c) -> [OutputValue c]
forall a. Positional a -> [a]
pValues (Positional (OutputValue c) -> [OutputValue c])
-> Positional (OutputValue c) -> [OutputValue c]
forall a b. (a -> b) -> a -> b
$ ReturnValues c -> Positional (OutputValue c)
forall c. ReturnValues c -> Positional (OutputValue c)
nrNames ReturnValues c
rs2) ((PassedValue c -> ValueType) -> [PassedValue c] -> [ValueType]
forall a b. (a -> b) -> [a] -> [b]
map PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType ([PassedValue c] -> [ValueType]) -> [PassedValue c] -> [ValueType]
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues Positional (PassedValue c)
rs1)
  let ns :: [ReturnVariable]
ns = (ReturnVariable -> Bool) -> [ReturnVariable] -> [ReturnVariable]
forall a. (a -> Bool) -> [a] -> [a]
filter (ValueType -> Bool
isStoredUnboxed (ValueType -> Bool)
-> (ReturnVariable -> ValueType) -> ReturnVariable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReturnVariable -> ValueType
rvType) [ReturnVariable]
ns0
  ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
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 {
      _pcScope :: SymbolScope
_pcScope = SymbolScope
s,
      _pcType :: CategoryName
_pcType = CategoryName
t,
      _pcExtParams :: Positional (ValueParam c)
_pcExtParams = Positional (ValueParam c)
ps,
      _pcMembers :: [DefinedMember c]
_pcMembers = [DefinedMember c]
ms,
      _pcCategories :: CategoryMap c
_pcCategories = CategoryMap c
tm,
      _pcAllFilters :: ParamFilters
_pcAllFilters = ParamFilters
allFilters,
      _pcExtFilters :: [ParamFilter c]
_pcExtFilters = [ParamFilter c]
pa',
      _pcParamScopes :: Map ParamName SymbolScope
_pcParamScopes = Map ParamName SymbolScope
sa,
      _pcFunctions :: Map FunctionName (ScopedFunction c)
_pcFunctions = Map FunctionName (ScopedFunction c)
fa,
      _pcVariables :: Map VariableName (VariableValue c)
_pcVariables = Map VariableName (VariableValue c)
va'',
      _pcReturns :: ReturnValidation c
_pcReturns = ReturnValidation c
rs',
      _pcDeferred :: DeferVariable c
_pcDeferred = DeferVariable c
forall c. DeferVariable c
emptyDeferred,
      _pcJumpType :: JumpType
_pcJumpType = JumpType
NextStatement,
      _pcIsNamed :: Bool
_pcIsNamed = Bool -> Bool
not (ReturnValues c -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns ReturnValues c
rs2),
      _pcPrimNamed :: [ReturnVariable]
_pcPrimNamed = [ReturnVariable]
ns,
      _pcRequiredTypes :: Set CategoryName
_pcRequiredTypes = Set CategoryName
forall a. Set a
Set.empty,
      _pcOutput :: [String]
_pcOutput = [],
      _pcDisallowInit :: Bool
_pcDisallowInit = Bool
False,
      _pcLoopSetup :: LoopSetup [String]
_pcLoopSetup = LoopSetup [String]
forall s. LoopSetup s
NotInLoop,
      _pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
_pcCleanupBlocks = [],
      _pcInCleanup :: Bool
_pcInCleanup = Bool
False,
      _pcUsedVars :: [UsedVariable c]
_pcUsedVars = [],
      _pcExprMap :: ExprMap c
_pcExprMap = ExprMap c
em,
      _pcReservedMacros :: [(MacroName, [c])]
_pcReservedMacros = [],
      _pcNoTrace :: Bool
_pcNoTrace = Bool
False,
      _pcTestsOnly :: Bool
_pcTestsOnly = Bool
to,
      _pcTraces :: [String]
_pcTraces = [],
      _pcParentCall :: Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
_pcParentCall = Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
parentCall
    }
  where
    pairOutput :: PassedValue c -> OutputValue c -> m (VariableName, PassedValue c)
pairOutput (PassedValue [c]
c1 ValueType
t2) (OutputValue [c]
c2 VariableName
n2) = (VariableName, PassedValue c) -> m (VariableName, PassedValue c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((VariableName, PassedValue c) -> m (VariableName, PassedValue c))
-> (VariableName, PassedValue c) -> m (VariableName, PassedValue c)
forall a b. (a -> b) -> a -> b
$ (VariableName
n2,[c] -> ValueType -> PassedValue c
forall c. [c] -> ValueType -> PassedValue c
PassedValue ([c]
c2[c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++[c]
c1) ValueType
t2)
    args :: Positional (Maybe (CallArgLabel c), InputValue c)
args = [(Maybe (CallArgLabel c), InputValue c)]
-> Positional (Maybe (CallArgLabel c), InputValue c)
forall a. [a] -> Positional a
Positional ([(Maybe (CallArgLabel c), InputValue c)]
 -> Positional (Maybe (CallArgLabel c), InputValue c))
-> [(Maybe (CallArgLabel c), InputValue c)]
-> Positional (Maybe (CallArgLabel c), InputValue c)
forall a b. (a -> b) -> a -> b
$ [Maybe (CallArgLabel c)]
-> [InputValue c] -> [(Maybe (CallArgLabel c), InputValue c)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((PassedValue c, Maybe (CallArgLabel c)) -> Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
-> [Maybe (CallArgLabel c)]
forall a b. (a -> b) -> [a] -> [b]
map (PassedValue c, Maybe (CallArgLabel c)) -> Maybe (CallArgLabel c)
forall a b. (a, b) -> b
snd ([(PassedValue c, Maybe (CallArgLabel c))]
 -> [Maybe (CallArgLabel c)])
-> [(PassedValue c, Maybe (CallArgLabel c))]
-> [Maybe (CallArgLabel c)]
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a. Positional a -> [a]
pValues Positional (PassedValue c, Maybe (CallArgLabel c))
as1) (Positional (InputValue c) -> [InputValue c]
forall a. Positional a -> [a]
pValues (Positional (InputValue c) -> [InputValue c])
-> Positional (InputValue c) -> [InputValue c]
forall a b. (a -> b) -> a -> b
$ ArgValues c -> Positional (InputValue c)
forall c. ArgValues c -> Positional (InputValue c)
avNames ArgValues c
as2)
    parentCall :: Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
parentCall = (Positional ParamName,
 Positional (Maybe (CallArgLabel c), InputValue c))
-> Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c))
forall a. a -> Maybe a
Just ((ValueParam c -> ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> Positional a -> Positional b
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)
ps1,Positional (Maybe (CallArgLabel c), InputValue c)
args)

getMainContext :: CollectErrorsM m => Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
getMainContext :: forall (m :: * -> *) c.
CollectErrorsM m =>
Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
getMainContext Bool
to CategoryMap c
tm ExprMap c
em = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
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 {
    _pcScope :: SymbolScope
_pcScope = SymbolScope
LocalScope,
    _pcType :: CategoryName
_pcType = CategoryName
CategoryNone,
    _pcExtParams :: Positional (ValueParam c)
_pcExtParams = [ValueParam c] -> Positional (ValueParam c)
forall a. [a] -> Positional a
Positional [],
    _pcMembers :: [DefinedMember c]
_pcMembers = [],
    _pcCategories :: CategoryMap c
_pcCategories = CategoryMap c
tm,
    _pcAllFilters :: ParamFilters
_pcAllFilters = ParamFilters
forall k a. Map k a
Map.empty,
    _pcExtFilters :: [ParamFilter c]
_pcExtFilters = [],
    _pcParamScopes :: Map ParamName SymbolScope
_pcParamScopes = Map ParamName SymbolScope
forall k a. Map k a
Map.empty,
    _pcFunctions :: Map FunctionName (ScopedFunction c)
_pcFunctions = Map FunctionName (ScopedFunction c)
forall k a. Map k a
Map.empty,
    _pcVariables :: Map VariableName (VariableValue c)
_pcVariables = Map VariableName (VariableValue c)
forall k a. Map k a
Map.empty,
    _pcReturns :: ReturnValidation c
_pcReturns = Positional (PassedValue c) -> ReturnValidation c
forall c. Positional (PassedValue c) -> ReturnValidation c
ValidatePositions ([PassedValue c] -> Positional (PassedValue c)
forall a. [a] -> Positional a
Positional []),
    _pcDeferred :: DeferVariable c
_pcDeferred = DeferVariable c
forall c. DeferVariable c
emptyDeferred,
    _pcJumpType :: JumpType
_pcJumpType = JumpType
NextStatement,
    _pcIsNamed :: Bool
_pcIsNamed = Bool
False,
    _pcPrimNamed :: [ReturnVariable]
_pcPrimNamed = [],
    _pcRequiredTypes :: Set CategoryName
_pcRequiredTypes = Set CategoryName
forall a. Set a
Set.empty,
    _pcOutput :: [String]
_pcOutput = [],
    _pcDisallowInit :: Bool
_pcDisallowInit = Bool
False,
    _pcLoopSetup :: LoopSetup [String]
_pcLoopSetup = LoopSetup [String]
forall s. LoopSetup s
NotInLoop,
    _pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
_pcCleanupBlocks = [],
    _pcInCleanup :: Bool
_pcInCleanup = Bool
False,
    _pcUsedVars :: [UsedVariable c]
_pcUsedVars = [],
    _pcExprMap :: ExprMap c
_pcExprMap = ExprMap c
em,
    _pcReservedMacros :: [(MacroName, [c])]
_pcReservedMacros = [],
    _pcNoTrace :: Bool
_pcNoTrace = Bool
False,
    _pcTestsOnly :: Bool
_pcTestsOnly = Bool
to,
    _pcTraces :: [String]
_pcTraces = [],
    _pcParentCall :: Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
_pcParentCall = Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
forall a. Maybe a
Nothing
  }