{- -----------------------------------------------------------------------------
Copyright 2019-2020 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 FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe #-}

module Compilation.ProcedureContext (
  ExprMap,
  ProcedureContext(..),
  ReturnValidation(..),
  updateArgVariables,
  updateReturnVariables,
) where

import Control.Monad (when)
import Data.Maybe (fromJust,isJust)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.GeneralType
import Base.MergeTree
import Base.Positional
import Compilation.CompilerState
import Types.DefinedCategory
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 -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks :: [Maybe (CleanupBlock c [String])],
    ProcedureContext c -> Bool
pcInCleanup :: Bool,
    ProcedureContext c -> [UsedVariable c]
pcUsedVars :: [UsedVariable c],
    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)
  }
  deriving (Int -> ReturnValidation c -> ShowS
[ReturnValidation c] -> ShowS
ReturnValidation c -> String
(Int -> ReturnValidation c -> ShowS)
-> (ReturnValidation c -> String)
-> ([ReturnValidation c] -> ShowS)
-> Show (ReturnValidation c)
forall c. Show c => Int -> ReturnValidation c -> ShowS
forall c. Show c => [ReturnValidation c] -> ShowS
forall c. Show c => ReturnValidation c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnValidation c] -> ShowS
$cshowList :: forall c. Show c => [ReturnValidation c] -> ShowS
show :: ReturnValidation c -> String
$cshow :: forall c. Show c => ReturnValidation c -> String
showsPrec :: Int -> ReturnValidation c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> ReturnValidation c -> ShowS
Show)

instance (Show c, CollectErrorsM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m SymbolScope) -> String -> m SymbolScope
forall a b. (a -> b) -> a -> b
$ String
"Param " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" does not exist"
  ccAddRequired :: ProcedureContext c -> Set CategoryName -> m (ProcedureContext c)
ccAddRequired 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
      pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
      pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
      pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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
      -- Same category as the procedure itself.
      | 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.
ErrorContextM 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
      -- A different category than the procedure.
      | Bool
otherwise = do
        ([c]
_,AnyCategory c
ca) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM 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.
ErrorContextM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       String
" disallowed during initialization" String -> ShowS
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. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t String -> ShowS
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. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction c)) -> String -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
" does not have a category function named " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
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 :: * -> *).
CollectErrorsM 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. ErrorContextM m => p -> m a
getFromAny [m (ScopedFunction c)] -> m (ScopedFunction c)
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Use explicit type conversion to call " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from " String -> ShowS
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.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m a
collectFirstM f (m a)
ts m a -> String -> m a
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
        String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not available for type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe GeneralInstance -> String
forall a. Show a => a -> String
show Maybe GeneralInstance
t String -> ShowS
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. ErrorContextM m => String -> m a
compilerErrorM (String -> m [TypeFilter]) -> String -> m [TypeFilter]
forall a b. (a -> b) -> a -> b
$ String
"Param " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
p String -> ShowS
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.
(CollectErrorsM 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 :: * -> *).
CollectErrorsM m =>
DefinesInstance -> m (ScopedFunction c)
checkDefine [DefinesInstance]
ds) m (ScopedFunction c) -> String -> m (ScopedFunction c)
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
        String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not available for param " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
    getFromSingle (JustTypeInstance TypeInstance
t2)
      -- Same category as the procedure itself.
      | 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.
(CollectErrorsM 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
      -- A different category than the procedure.
      | Bool
otherwise = do
        ([c]
_,AnyCategory c
ca) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM 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.
(CollectErrorsM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction c)) -> String -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe GeneralInstance -> String
forall a. Show a => a -> String
show Maybe GeneralInstance
t String -> ShowS
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, CollectErrorsM 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.
(CollectErrorsM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       String
" disallowed during initialization" String -> ShowS
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. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t2 String -> ShowS
forall a. [a] -> [a] -> [a]
++
                       String
" is a category function" String -> ShowS
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, CollectErrorsM 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. ErrorContextM m => m a -> String -> m a
<??
        String
"In external function call at " String -> ShowS
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, CollectErrorsM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction c)) -> String -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t2 String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
" does not have a type or value function named " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
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. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cannot initialize values from " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     CategoryName -> String
forall a. Show a => a -> String
show CategoryName
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
    | Bool
otherwise = String
"In initialization at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM 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, CollectErrorsM 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, CollectErrorsM 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.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> TypeInstance -> m ()
validateTypeInstance AnyTypeResolver
r ParamFilters
allFilters TypeInstance
t'
      -- Check internal param substitution.
      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, CollectErrorsM 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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Map ParamName GeneralInstance -> [TypeFilter] -> m [TypeFilter]
forall (m :: * -> *).
CollectErrorsM 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, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ (AnyTypeResolver
-> ParamFilters -> GeneralInstance -> [TypeFilter] -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> [TypeFilter] -> m ()
validateAssignment AnyTypeResolver
r ParamFilters
allFilters) Positional GeneralInstance
ps Positional [TypeFilter]
subbed
      -- Check initializer types.
      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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (Map ParamName GeneralInstance
-> DefinedMember c -> m (MemberValue c)
forall (m :: * -> *) c.
CollectErrorsM 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, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ (AnyTypeResolver
-> ParamFilters -> MemberValue c -> (Int, ValueType) -> m ()
forall (m :: * -> *) r a a.
(CollectErrorsM 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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM ((ParamName -> m GeneralInstance) -> TypeFilter -> m TypeFilter
forall (m :: * -> *).
CollectErrorsM 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 :: * -> *).
ErrorContextM 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.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment r
r ParamFilters
fa ValueType
t1 ValueType
t0 m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
            String
"In initializer " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> ShowS
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 :: * -> *).
CollectErrorsM m =>
(ParamName -> m GeneralInstance) -> ValueType -> m ValueType
uncheckedSubValueType (Map ParamName GeneralInstance -> ParamName -> m GeneralInstance
forall (m :: * -> *).
ErrorContextM 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 -> UsedVariable c -> m (VariableValue c)
ccGetVariable ProcedureContext c
ctx (UsedVariable [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. ErrorContextM m => String -> m a
compilerErrorM (String -> m (VariableValue c)) -> String -> m (VariableValue c)
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not defined" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  ccAddVariable :: ProcedureContext c
-> UsedVariable c -> VariableValue c -> m (ProcedureContext c)
ccAddVariable ProcedureContext c
ctx (UsedVariable [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. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       String
" is already defined: " String -> ShowS
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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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 -> [UsedVariable c] -> m ()
ccCheckVariableInit ProcedureContext c
ctx [UsedVariable c]
vs
    -- Returns are checked during cleanup inlining.
    | ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        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 -> (UsedVariable c -> m ()) -> [UsedVariable c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (Map VariableName (PassedValue c) -> UsedVariable c -> m ()
forall (f :: * -> *) a a.
(ErrorContextM f, Show a) =>
Map VariableName a -> UsedVariable a -> f ()
checkSingle Map VariableName (PassedValue c)
na) [UsedVariable c]
vs
             ReturnValidation c
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        where
          checkSingle :: Map VariableName a -> UsedVariable a -> f ()
checkSingle Map VariableName a
na (UsedVariable [a]
c VariableName
n) =
             Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VariableName
n VariableName -> Map VariableName a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map VariableName a
na) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
               String -> f ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ String
"Named return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                String
" might not be initialized" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
  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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
      pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
      pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
      pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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
  ccAddUsed :: ProcedureContext c -> UsedVariable c -> m (ProcedureContext c)
ccAddUsed ProcedureContext c
ctx UsedVariable c
v
    | ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
          pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
          pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
          pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars ProcedureContext c
ctx [UsedVariable c] -> [UsedVariable c] -> [UsedVariable c]
forall a. [a] -> [a] -> [a]
++ [UsedVariable c
v],
          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
        }
    | Bool
otherwise = 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
      pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
      pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
      pcUsedVars :: [UsedVariable c]
pcUsedVars = [UsedVariable c]
used,
      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
      used :: [UsedVariable c]
used = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars ProcedureContext c
ctx [UsedVariable c] -> [UsedVariable c] -> [UsedVariable c]
forall a. [a] -> [a] -> [a]
++ ([[UsedVariable c]] -> [UsedVariable c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[UsedVariable c]] -> [UsedVariable c])
-> [[UsedVariable c]] -> [UsedVariable c]
forall a b. (a -> b) -> a -> b
$ (ProcedureContext c -> [UsedVariable c])
-> [ProcedureContext c] -> [[UsedVariable c]]
forall a b. (a -> b) -> [a] -> [b]
map ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars [ProcedureContext c]
cs)
      (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)
      -- Ignore a branch if it jumps to a higher scope.
      combineParallel :: (ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType) -> (ReturnValidation c, JumpType)
combineParallel (ReturnValidation c
_,JumpType
j1) (ReturnValidation c
r,JumpType
j2) | 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)
  ccInheritUsed :: ProcedureContext c -> ProcedureContext c -> m (ProcedureContext c)
ccInheritUsed ProcedureContext c
ctx ProcedureContext c
ctx2 = 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
      pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
      pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
      pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars ProcedureContext c
ctx [UsedVariable c] -> [UsedVariable c] -> [UsedVariable c]
forall a. [a] -> [a] -> [a]
++ ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars ProcedureContext c
ctx2,
      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
    }
  ccRegisterReturn :: ProcedureContext c
-> [c] -> Maybe ExpressionType -> m (ProcedureContext c)
ccRegisterReturn ProcedureContext c
ctx [c]
c Maybe ExpressionType
vs = do
    ReturnValidation c
returns <- ReturnValidation c -> m (ReturnValidation c)
forall (m :: * -> *) c.
(CollectErrorsM 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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
        -- Check for a count match first, to avoid the default error message.
        (ValueType -> ValueType -> m (ValueType, ValueType))
-> ExpressionType -> ExpressionType -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM 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. ErrorContextM m => m a -> String -> m a
<??
          String
"In procedure return at " String -> ShowS
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, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ PassedValue c -> (Int, ValueType) -> m ()
forall (m :: * -> *) c a.
(CollectErrorsM 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. ErrorContextM m => m a -> String -> m a
<??
          String
"In procedure return at " String -> ShowS
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.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
pa ValueType
t ValueType
t0 m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
              String
"Cannot convert " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PassedValue c -> String
forall a. Show a => a -> String
show PassedValue c
ta0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in return " String -> ShowS
forall a. [a] -> [a] -> [a]
++
               a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (VariableName, PassedValue c) -> m Any
forall (m :: * -> *) a b a.
(ErrorContextM m, Show a) =>
(a, b) -> 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, b) -> m a
alwaysError (a
n,b
_) = String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Named return " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                           String
" might not be initialized" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                           [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [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 -> [c] -> JumpType -> m (ProcedureContext c)
ccSetJumpType ProcedureContext c
ctx [c]
c JumpType
j
    | ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx Bool -> Bool -> Bool
&& JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpBreak =
        String -> m (ProcedureContext c)
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ProcedureContext c))
-> String -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ String
"Explicit break at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not allowed in cleanup"
    | ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx Bool -> Bool -> Bool
&& JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpContinue =
        String -> m (ProcedureContext c)
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ProcedureContext c))
-> String -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ String
"Explicit continue at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not allowed in cleanup"
    | ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx Bool -> Bool -> Bool
&& JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpReturn =
        String -> m (ProcedureContext c)
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ProcedureContext c))
-> String -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ String
"Explicit return at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not allowed in cleanup"
    | Bool
otherwise =
      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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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 -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
max JumpType
j (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,
          pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
          pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
          pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = Maybe (CleanupBlock c [String])
forall a. Maybe a
NothingMaybe (CleanupBlock c [String])
-> [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall a. a -> [a] -> [a]
:(ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx),
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = Bool
True,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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
      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 -> ProcedureContext c -> m (ProcedureContext c)
ccPushCleanup ProcedureContext c
ctx ProcedureContext c
ctx2 =
    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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = (CleanupBlock c [String] -> Maybe (CleanupBlock c [String])
forall a. a -> Maybe a
Just CleanupBlock c [String]
cleanup)Maybe (CleanupBlock c [String])
-> [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall a. a -> [a] -> [a]
:(ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx),
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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
        cleanup :: CleanupBlock c [String]
cleanup = [String]
-> [UsedVariable c]
-> JumpType
-> Set CategoryName
-> CleanupBlock c [String]
forall c s.
s
-> [UsedVariable c]
-> JumpType
-> Set CategoryName
-> CleanupBlock c s
CleanupBlock (ProcedureContext c -> [String]
forall c. ProcedureContext c -> [String]
pcOutput ProcedureContext c
ctx2) (ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars ProcedureContext c
ctx2) (ProcedureContext c -> JumpType
forall c. ProcedureContext c -> JumpType
pcJumpType ProcedureContext c
ctx2) (ProcedureContext c -> Set CategoryName
forall c. ProcedureContext c -> Set CategoryName
pcRequiredTypes ProcedureContext c
ctx2)
  ccGetCleanup :: ProcedureContext c -> JumpType -> m (CleanupBlock c [String])
ccGetCleanup ProcedureContext c
ctx JumpType
j = CleanupBlock c [String] -> m (CleanupBlock c [String])
forall (m :: * -> *) a. Monad m => a -> m a
return CleanupBlock c [String]
combined where
    combined :: CleanupBlock c [String]
combined
      | JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
NextStatement =
          case ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx of
               ((Just CleanupBlock c [String]
b):[Maybe (CleanupBlock c [String])]
_) -> CleanupBlock c [String]
b
               [Maybe (CleanupBlock c [String])]
_            -> CleanupBlock c [String]
forall s c. Monoid s => CleanupBlock c s
emptyCleanupBlock
      | JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpReturn                     = [CleanupBlock c [String]] -> CleanupBlock c [String]
forall c a. [CleanupBlock c [a]] -> CleanupBlock c [a]
combine ([CleanupBlock c [String]] -> CleanupBlock c [String])
-> [CleanupBlock c [String]] -> CleanupBlock c [String]
forall a b. (a -> b) -> a -> b
$ (Maybe (CleanupBlock c [String]) -> CleanupBlock c [String])
-> [Maybe (CleanupBlock c [String])] -> [CleanupBlock c [String]]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (CleanupBlock c [String]) -> CleanupBlock c [String]
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe (CleanupBlock c [String])] -> [CleanupBlock c [String]])
-> [Maybe (CleanupBlock c [String])] -> [CleanupBlock c [String]]
forall a b. (a -> b) -> a -> b
$ (Maybe (CleanupBlock c [String]) -> Bool)
-> [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall a. (a -> Bool) -> [a] -> [a]
filter    Maybe (CleanupBlock c [String]) -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe (CleanupBlock c [String])]
 -> [Maybe (CleanupBlock c [String])])
-> [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks 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
JumpContinue = [CleanupBlock c [String]] -> CleanupBlock c [String]
forall c a. [CleanupBlock c [a]] -> CleanupBlock c [a]
combine ([CleanupBlock c [String]] -> CleanupBlock c [String])
-> [CleanupBlock c [String]] -> CleanupBlock c [String]
forall a b. (a -> b) -> a -> b
$ (Maybe (CleanupBlock c [String]) -> CleanupBlock c [String])
-> [Maybe (CleanupBlock c [String])] -> [CleanupBlock c [String]]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (CleanupBlock c [String]) -> CleanupBlock c [String]
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe (CleanupBlock c [String])] -> [CleanupBlock c [String]])
-> [Maybe (CleanupBlock c [String])] -> [CleanupBlock c [String]]
forall a b. (a -> b) -> a -> b
$ (Maybe (CleanupBlock c [String]) -> Bool)
-> [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe (CleanupBlock c [String]) -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe (CleanupBlock c [String])]
 -> [Maybe (CleanupBlock c [String])])
-> [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx
      | Bool
otherwise = CleanupBlock c [String]
forall s c. Monoid s => CleanupBlock c s
emptyCleanupBlock
    combine :: [CleanupBlock c [a]] -> CleanupBlock c [a]
combine [CleanupBlock c [a]]
cs = [a]
-> [UsedVariable c]
-> JumpType
-> Set CategoryName
-> CleanupBlock c [a]
forall c s.
s
-> [UsedVariable c]
-> JumpType
-> Set CategoryName
-> CleanupBlock c s
CleanupBlock ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ (CleanupBlock c [a] -> [a]) -> [CleanupBlock c [a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map CleanupBlock c [a] -> [a]
forall c s. CleanupBlock c s -> s
csCleanup [CleanupBlock c [a]]
cs)
                              ([[UsedVariable c]] -> [UsedVariable c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[UsedVariable c]] -> [UsedVariable c])
-> [[UsedVariable c]] -> [UsedVariable c]
forall a b. (a -> b) -> a -> b
$ (CleanupBlock c [a] -> [UsedVariable c])
-> [CleanupBlock c [a]] -> [[UsedVariable c]]
forall a b. (a -> b) -> [a] -> [b]
map CleanupBlock c [a] -> [UsedVariable c]
forall c s. CleanupBlock c s -> [UsedVariable c]
csUsesVars [CleanupBlock c [a]]
cs)
                              ((JumpType -> JumpType -> JumpType)
-> JumpType -> [JumpType] -> JumpType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
max JumpType
NextStatement ((CleanupBlock c [a] -> JumpType)
-> [CleanupBlock c [a]] -> [JumpType]
forall a b. (a -> b) -> [a] -> [b]
map CleanupBlock c [a] -> JumpType
forall c s. CleanupBlock c s -> JumpType
csJumpType [CleanupBlock c [a]]
cs))
                              ([Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (CleanupBlock c [a] -> Set CategoryName)
-> [CleanupBlock c [a]] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map CleanupBlock c [a] -> Set CategoryName
forall c s. CleanupBlock c s -> Set CategoryName
csRequires [CleanupBlock c [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. ErrorContextM m => String -> m a
compilerErrorM (String -> m (Expression c)) -> String -> m (Expression c)
forall a b. (a -> b) -> a -> b
$ String
"Env expression " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MacroName -> String
forall a. Show a => a -> String
show MacroName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not defined" String -> ShowS
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.
(CollectErrorsM 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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (MacroName, [a]) -> m Any
forall (m :: * -> *) a a a.
(ErrorContextM 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. ErrorContextM m => m a -> String -> m a
<!!
            String
"Expression macro " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MacroName -> String
forall a. Show a => a -> String
show MacroName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" references itself"
      singleError :: (a, [a]) -> m a
singleError (a
n2,[a]
c2) = String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expanded at " String -> ShowS
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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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]
-> [Maybe (CleanupBlock c [String])]
-> Bool
-> [UsedVariable c]
-> 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,
        pcCleanupBlocks :: [Maybe (CleanupBlock c [String])]
pcCleanupBlocks = ProcedureContext c -> [Maybe (CleanupBlock c [String])]
forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
pcCleanupBlocks ProcedureContext c
ctx,
        pcInCleanup :: Bool
pcInCleanup = ProcedureContext c -> Bool
forall c. ProcedureContext c -> Bool
pcInCleanup ProcedureContext c
ctx,
        pcUsedVars :: [UsedVariable c]
pcUsedVars = ProcedureContext c -> [UsedVariable c]
forall c. ProcedureContext c -> [UsedVariable c]
pcUsedVars 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, CollectErrorsM 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, CollectErrorsM 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.
(ErrorContextM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m (Map VariableName (VariableValue a)))
-> String -> m (Map VariableName (VariableValue a))
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> ShowS
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 -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++
                                          String
" is already defined" String -> ShowS
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, CollectErrorsM 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, CollectErrorsM 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.
(ErrorContextM 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. ErrorContextM m => String -> m a
compilerErrorM (String -> m (Map VariableName (VariableValue a)))
-> String -> m (Map VariableName (VariableValue a))
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> ShowS
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 -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       String
" is already defined" String -> ShowS
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)