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

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

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

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

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

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}

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

import Control.Monad (foldM,when)
import Data.List (nub)
import Data.Maybe (fromJust,isJust)
import Lens.Micro hiding (mapped)
import Lens.Micro.TH
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.Function
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


type ExprMap c = Map.Map MacroName (Expression c)

data ReturnValidation c =
  ValidatePositions {
    forall c. ReturnValidation c -> Positional (PassedValue c)
vpReturns :: Positional (PassedValue c)
  } |
  ValidateNames {
    forall c. ReturnValidation c -> Positional VariableName
vnNames :: Positional VariableName,
    forall c. ReturnValidation c -> Positional (PassedValue c)
vnTypes :: Positional (PassedValue c),
    forall c. ReturnValidation c -> DeferVariable c
vnRemaining :: DeferVariable 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
$cshowsPrec :: forall c. Show c => Int -> ReturnValidation c -> ShowS
showsPrec :: Int -> ReturnValidation c -> ShowS
$cshow :: forall c. Show c => ReturnValidation c -> String
show :: ReturnValidation c -> String
$cshowList :: forall c. Show c => [ReturnValidation c] -> ShowS
showList :: [ReturnValidation c] -> ShowS
Show)

data ProcedureContext c =
  ProcedureContext {
    forall c. ProcedureContext c -> SymbolScope
_pcScope :: SymbolScope,
    forall c. ProcedureContext c -> CategoryName
_pcType :: CategoryName,
    forall c. ProcedureContext c -> Positional (ValueParam c)
_pcExtParams :: Positional (ValueParam c),
    forall c. ProcedureContext c -> [DefinedMember c]
_pcMembers :: [DefinedMember c],
    forall c. ProcedureContext c -> CategoryMap c
_pcCategories :: CategoryMap c,
    forall c. ProcedureContext c -> ParamFilters
_pcAllFilters :: ParamFilters,
    forall c. ProcedureContext c -> [ParamFilter c]
_pcExtFilters :: [ParamFilter c],
    forall c. ProcedureContext c -> Map ParamName SymbolScope
_pcParamScopes :: Map.Map ParamName SymbolScope,
    forall c. ProcedureContext c -> Map FunctionName (ScopedFunction c)
_pcFunctions :: Map.Map FunctionName (ScopedFunction c),
    forall c. ProcedureContext c -> Map VariableName (VariableValue c)
_pcVariables :: Map.Map VariableName (VariableValue c),
    forall c. ProcedureContext c -> ReturnValidation c
_pcReturns :: ReturnValidation c,
    forall c. ProcedureContext c -> DeferVariable c
_pcDeferred :: DeferVariable c,
    forall c. ProcedureContext c -> JumpType
_pcJumpType :: JumpType,
    forall c. ProcedureContext c -> Bool
_pcIsNamed :: Bool,
    forall c. ProcedureContext c -> [ReturnVariable]
_pcPrimNamed :: [ReturnVariable],
    forall c. ProcedureContext c -> Set CategoryName
_pcRequiredTypes :: Set.Set CategoryName,
    forall c. ProcedureContext c -> [String]
_pcOutput :: [String],
    forall c. ProcedureContext c -> Bool
_pcDisallowInit :: Bool,
    forall c. ProcedureContext c -> LoopSetup [String]
_pcLoopSetup :: LoopSetup [String],
    forall c. ProcedureContext c -> [Maybe (CleanupBlock c [String])]
_pcCleanupBlocks :: [Maybe (CleanupBlock c [String])],
    forall c. ProcedureContext c -> Bool
_pcInCleanup :: Bool,
    forall c. ProcedureContext c -> [UsedVariable c]
_pcUsedVars :: [UsedVariable c],
    forall c. ProcedureContext c -> ExprMap c
_pcExprMap :: ExprMap c,
    forall c. ProcedureContext c -> [(MacroName, [c])]
_pcReservedMacros :: [(MacroName,[c])],
    forall c. ProcedureContext c -> Bool
_pcNoTrace :: Bool,
    forall c. ProcedureContext c -> Bool
_pcTestsOnly :: Bool,
    forall c. ProcedureContext c -> [String]
_pcTraces :: [String],
    forall c.
ProcedureContext c
-> Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c))
_pcParentCall :: Maybe (Positional ParamName,Positional (Maybe (CallArgLabel c), InputValue c))
  }

$(makeLenses ''ProcedureContext)

instance (Show c, CollectErrorsM m) =>
  CompilerContext c m [String] (ProcedureContext c) where
  ccCurrentScope :: ProcedureContext c -> m SymbolScope
ccCurrentScope = SymbolScope -> m SymbolScope
forall a. a -> m a
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
-> Getting SymbolScope (ProcedureContext c) SymbolScope
-> SymbolScope
forall s a. s -> Getting a s a -> a
^. Getting SymbolScope (ProcedureContext c) SymbolScope
forall c (f :: * -> *).
Functor f =>
(SymbolScope -> f SymbolScope)
-> ProcedureContext c -> f (ProcedureContext c)
pcScope)
  ccResolver :: ProcedureContext c -> m AnyTypeResolver
ccResolver = AnyTypeResolver -> m AnyTypeResolver
forall a. a -> m a
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
-> Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
-> CategoryMap c
forall s a. s -> Getting a s a -> a
^. Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
forall c (f :: * -> *).
Functor f =>
(CategoryMap c -> f (CategoryMap c))
-> ProcedureContext c -> f (ProcedureContext c)
pcCategories)
  ccSameType :: ProcedureContext c -> TypeInstance -> m Bool
ccSameType ProcedureContext c
ctx TypeInstance
t
    | ProcedureContext c
ctx ProcedureContext c
-> Getting SymbolScope (ProcedureContext c) SymbolScope
-> SymbolScope
forall s a. s -> Getting a s a -> a
^. Getting SymbolScope (ProcedureContext c) SymbolScope
forall c (f :: * -> *).
Functor f =>
(SymbolScope -> f SymbolScope)
-> ProcedureContext c -> f (ProcedureContext c)
pcScope SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    | Bool
otherwise = ProcedureContext c -> m TypeInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m TypeInstance
ccSelfType ProcedureContext c
ctx m TypeInstance -> (TypeInstance -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m Bool
forall a. a -> m a
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
t)
  ccSelfType :: ProcedureContext c -> m TypeInstance
ccSelfType ProcedureContext c
ctx
    | ProcedureContext c
ctx ProcedureContext c
-> Getting SymbolScope (ProcedureContext c) SymbolScope
-> SymbolScope
forall s a. s -> Getting a s a -> a
^. Getting SymbolScope (ProcedureContext c) SymbolScope
forall c (f :: * -> *).
Functor f =>
(SymbolScope -> f SymbolScope)
-> ProcedureContext c -> f (ProcedureContext c)
pcScope SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope = String -> m TypeInstance
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m TypeInstance) -> String -> m TypeInstance
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
ParamSelf String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found"
    | Bool
otherwise = TypeInstance -> m TypeInstance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeInstance -> m TypeInstance) -> TypeInstance -> m TypeInstance
forall a b. (a -> b) -> a -> b
$ CategoryName -> InstanceParams -> TypeInstance
TypeInstance (ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType)
                                        ((ValueParam c -> GeneralInstance)
-> Positional (ValueParam c) -> InstanceParams
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> (ValueParam c -> TypeInstanceOrParam)
-> ValueParam c
-> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False (ParamName -> TypeInstanceOrParam)
-> (ValueParam c -> ParamName)
-> ValueParam c
-> TypeInstanceOrParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam) (Positional (ValueParam c) -> InstanceParams)
-> Positional (ValueParam c) -> InstanceParams
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting
     (Positional (ValueParam c))
     (ProcedureContext c)
     (Positional (ValueParam c))
-> Positional (ValueParam c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Positional (ValueParam c))
  (ProcedureContext c)
  (Positional (ValueParam c))
forall c (f :: * -> *).
Functor f =>
(Positional (ValueParam c) -> f (Positional (ValueParam c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcExtParams)
  ccAllFilters :: ProcedureContext c -> m ParamFilters
ccAllFilters = ParamFilters -> m ParamFilters
forall a. a -> m a
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
-> Getting ParamFilters (ProcedureContext c) ParamFilters
-> ParamFilters
forall s a. s -> Getting a s a -> a
^. Getting ParamFilters (ProcedureContext c) ParamFilters
forall c (f :: * -> *).
Functor f =>
(ParamFilters -> f ParamFilters)
-> ProcedureContext c -> f (ProcedureContext c)
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
ctx ProcedureContext c
-> Getting
     (Map ParamName SymbolScope)
     (ProcedureContext c)
     (Map ParamName SymbolScope)
-> Map ParamName SymbolScope
forall s a. s -> Getting a s a -> a
^. Getting
  (Map ParamName SymbolScope)
  (ProcedureContext c)
  (Map ParamName SymbolScope)
forall c (f :: * -> *).
Functor f =>
(Map ParamName SymbolScope -> f (Map ParamName SymbolScope))
-> ProcedureContext c -> f (ProcedureContext c)
pcParamScopes) of
            (Just SymbolScope
s) -> SymbolScope -> m SymbolScope
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SymbolScope
s
            Maybe SymbolScope
_ -> String -> m SymbolScope
forall a. String -> m a
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
" not found"
  ccAddRequired :: ProcedureContext c -> Set CategoryName -> m (ProcedureContext c)
ccAddRequired ProcedureContext c
ctx Set CategoryName
ts = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (Set CategoryName -> Identity (Set CategoryName))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(Set CategoryName -> f (Set CategoryName))
-> ProcedureContext c -> f (ProcedureContext c)
pcRequiredTypes ((Set CategoryName -> Identity (Set CategoryName))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> Set CategoryName -> ProcedureContext c -> ProcedureContext c
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Set CategoryName
ts
  ccGetRequired :: ProcedureContext c -> m (Set CategoryName)
ccGetRequired = Set CategoryName -> m (Set CategoryName)
forall a. a -> m a
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
-> Getting
     (Set CategoryName) (ProcedureContext c) (Set CategoryName)
-> Set CategoryName
forall s a. s -> Getting a s a -> a
^. Getting (Set CategoryName) (ProcedureContext c) (Set CategoryName)
forall c (f :: * -> *).
Functor f =>
(Set CategoryName -> f (Set CategoryName))
-> ProcedureContext c -> f (ProcedureContext c)
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
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType) 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
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType = 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
ctx ProcedureContext c
-> Getting
     (Map FunctionName (ScopedFunction c))
     (ProcedureContext c)
     (Map FunctionName (ScopedFunction c))
-> Map FunctionName (ScopedFunction c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map FunctionName (ScopedFunction c))
  (ProcedureContext c)
  (Map FunctionName (ScopedFunction c))
forall c (f :: * -> *).
Functor f =>
(Map FunctionName (ScopedFunction c)
 -> f (Map FunctionName (ScopedFunction c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcFunctions)
      -- 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
ctx ProcedureContext c
-> Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
-> CategoryMap c
forall s a. s -> Getting a s a -> a
^. Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
forall c (f :: * -> *).
Functor f =>
(CategoryMap c -> f (CategoryMap c))
-> ProcedureContext c -> f (ProcedureContext c)
pcCategories) ([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
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcDisallowInit Bool -> Bool -> Bool
&& CategoryName
t CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType Bool -> Bool -> Bool
&& ProcedureContext c
ctx ProcedureContext c
-> Getting SymbolScope (ProcedureContext c) SymbolScope
-> SymbolScope
forall s a. s -> Getting a s a -> a
^. Getting SymbolScope (ProcedureContext c) SymbolScope
forall c (f :: * -> *).
Functor f =>
(SymbolScope -> f SymbolScope)
-> ProcedureContext c -> f (ProcedureContext c)
pcScope 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 a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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 a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedFunction c
f
    checkFunction Maybe (ScopedFunction c)
_ =
      String -> m (ScopedFunction c)
forall a. String -> m a
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 = do
    GeneralInstance
t' <- case ProcedureContext c
ctx ProcedureContext c
-> Getting SymbolScope (ProcedureContext c) SymbolScope
-> SymbolScope
forall s a. s -> Getting a s a -> a
^. Getting SymbolScope (ProcedureContext c) SymbolScope
forall c (f :: * -> *).
Functor f =>
(SymbolScope -> f SymbolScope)
-> ProcedureContext c -> f (ProcedureContext c)
pcScope of
               SymbolScope
CategoryScope -> case Maybe GeneralInstance
t of
                                     Maybe GeneralInstance
Nothing -> String -> m GeneralInstance
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m GeneralInstance) -> String -> m GeneralInstance
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
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType) 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
                                     Just GeneralInstance
t0 -> GeneralInstance -> m GeneralInstance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GeneralInstance
t0
               SymbolScope
_ -> do
                 GeneralInstance
self <- (TypeInstance -> GeneralInstance)
-> m TypeInstance -> m GeneralInstance
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> (TypeInstance -> TypeInstanceOrParam)
-> TypeInstance
-> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInstance -> TypeInstanceOrParam
JustTypeInstance) (m TypeInstance -> m GeneralInstance)
-> m TypeInstance -> m GeneralInstance
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> m TypeInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m TypeInstance
ccSelfType ProcedureContext c
ctx
                 case Maybe GeneralInstance
t of
                      Just GeneralInstance
t0 -> GeneralInstance -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> GeneralInstance -> m GeneralInstance
replaceSelfInstance GeneralInstance
self GeneralInstance
t0
                      Maybe GeneralInstance
Nothing -> GeneralInstance -> m GeneralInstance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GeneralInstance
self
    ScopedFunction c
f <- GeneralInstance -> GeneralInstance -> m (ScopedFunction c)
forall {m :: * -> *}.
CollectErrorsM m =>
GeneralInstance -> GeneralInstance -> m (ScopedFunction c)
getFunction GeneralInstance
t' GeneralInstance
t'
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
/= ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f Bool -> Bool -> Bool
&& ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
/= CategoryName
CategoryNone) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String
"In call to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> SymbolScope -> FunctionVisibility c -> ScopedFunction c -> m ()
forall {m :: * -> *} {c} {c}.
(CollectErrorsM m, Show c, Show c) =>
SymbolScope -> FunctionVisibility c -> ScopedFunction c -> m ()
checkVisibility (ProcedureContext c
ctx ProcedureContext c
-> Getting SymbolScope (ProcedureContext c) SymbolScope
-> SymbolScope
forall s a. s -> Getting a s a -> a
^. Getting SymbolScope (ProcedureContext c) SymbolScope
forall c (f :: * -> *).
Functor f =>
(SymbolScope -> f SymbolScope)
-> ProcedureContext c -> f (ProcedureContext c)
pcScope) (ScopedFunction c -> FunctionVisibility c
forall c. ScopedFunction c -> FunctionVisibility c
sfVisibility ScopedFunction c
f) ScopedFunction c
f
    ScopedFunction c -> m (ScopedFunction c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedFunction c
f where
      checkVisibility :: SymbolScope -> FunctionVisibility c -> ScopedFunction c -> m ()
checkVisibility SymbolScope
_ FunctionVisibility c
FunctionVisibilityDefault ScopedFunction c
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      checkVisibility SymbolScope
CategoryScope FunctionVisibility c
v ScopedFunction c
_ = String
"Function restricted to @type and @value contexts" String -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (FunctionVisibility c -> String
forall a. Show a => a -> String
show FunctionVisibility c
v)
      checkVisibility SymbolScope
_ FunctionVisibility c
_ ScopedFunction c
f = 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
allFilters <- ProcedureContext c -> m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m ParamFilters
ccAllFilters ProcedureContext c
ctx
        GeneralInstance
self <- (TypeInstance -> GeneralInstance)
-> m TypeInstance -> m GeneralInstance
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> (TypeInstance -> TypeInstanceOrParam)
-> TypeInstance
-> GeneralInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInstance -> TypeInstanceOrParam
JustTypeInstance) (m TypeInstance -> m GeneralInstance)
-> m TypeInstance -> m GeneralInstance
forall a b. (a -> b) -> a -> b
$ ProcedureContext c -> m TypeInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m TypeInstance
ccSelfType ProcedureContext c
ctx
        AnyTypeResolver
-> ParamFilters -> ScopedFunction c -> GeneralInstance -> m ()
forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ScopedFunction c -> GeneralInstance -> m ()
checkFunctionCallVisibility AnyTypeResolver
r ParamFilters
allFilters ScopedFunction c
f GeneralInstance
self
      multipleMatchError :: a -> [a] -> m a
multipleMatchError a
t2 [a]
fs = do
        String
"Multiple matches for 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
" called on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> m a -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
!!>
          [String] -> m a
forall (m :: * -> *) a. CollectErrorsM m => [String] -> m a
mapErrorsM ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
fs)
      tryMergeFrom :: [ScopedFunction c] -> ScopedFunction c -> m (ScopedFunction c)
tryMergeFrom [ScopedFunction c]
fs ScopedFunction c
f = do
        (ScopedFunction c -> m ()) -> [ScopedFunction c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (ScopedFunction c -> ScopedFunction c -> m ()
forall {m :: * -> *} {c} {c}.
(CollectErrorsM m, Show c, Show c) =>
ScopedFunction c -> ScopedFunction c -> m ()
tryMergeFunc ScopedFunction c
f) [ScopedFunction c]
fs
        ScopedFunction c -> m (ScopedFunction c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedFunction c
f
      tryMergeTo :: [ScopedFunction c] -> ScopedFunction c -> m (ScopedFunction c)
tryMergeTo [ScopedFunction c]
fs ScopedFunction c
f = do
        (ScopedFunction c -> m ()) -> [ScopedFunction c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ ((ScopedFunction c -> ScopedFunction c -> m ())
-> ScopedFunction c -> ScopedFunction c -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ScopedFunction c -> ScopedFunction c -> m ()
forall {m :: * -> *} {c} {c}.
(CollectErrorsM m, Show c, Show c) =>
ScopedFunction c -> ScopedFunction c -> m ()
tryMergeFunc ScopedFunction c
f) [ScopedFunction c]
fs
        ScopedFunction c -> m (ScopedFunction c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedFunction c
f
      tryMergeFunc :: ScopedFunction c -> ScopedFunction c -> m ()
tryMergeFunc ScopedFunction c
f1 ScopedFunction c
f2 = do
        FunctionType
f1' <- ScopedFunction c -> m FunctionType
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f1
        FunctionType
f2' <- ScopedFunction c -> m FunctionType
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f2
        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
        m () -> m ()
forall (m :: * -> *) a. CollectErrorsM m => m a -> m a
silenceErrorsM (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
checkFunctionConvert AnyTypeResolver
r ParamFilters
allFilters ParamValues
forall k a. Map k a
Map.empty FunctionType
f2' FunctionType
f1'
      getFunction :: GeneralInstance -> GeneralInstance -> m (ScopedFunction c)
getFunction GeneralInstance
t0 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 :: * -> *} {f :: * -> *} {a}.
(CollectErrorsM m, Foldable f, Show a) =>
f (m (ScopedFunction a)) -> m (ScopedFunction a)
getFromAny [m (ScopedFunction c)] -> m (ScopedFunction c)
forall {m :: * -> *} {f :: * -> *} {c}.
(Foldable f, CollectErrorsM m, Show c) =>
f (m (ScopedFunction c)) -> m (ScopedFunction c)
getFromAll (GeneralInstance -> TypeInstanceOrParam -> m (ScopedFunction c)
getFromSingle GeneralInstance
t0) GeneralInstance
t2
      getFromAny :: f (m (ScopedFunction a)) -> m (ScopedFunction a)
getFromAny f (m (ScopedFunction a))
fs = do
        let (Just GeneralInstance
t') = Maybe GeneralInstance
t  -- #self will never be a union.
        [ScopedFunction a]
fs2 <- f (m (ScopedFunction a)) -> m [ScopedFunction a]
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m [a]
forall (f :: * -> *) a. Foldable f => f (m a) -> m [a]
collectAllM f (m (ScopedFunction a))
fs m [ScopedFunction a] -> String -> m [ScopedFunction 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
" is not available for type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GeneralInstance -> String
forall a. Show a => a -> String
show GeneralInstance
t' String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
        case Map CategoryName [a] -> [(CategoryName, [a])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map CategoryName [a] -> [(CategoryName, [a])])
-> Map CategoryName [a] -> [(CategoryName, [a])]
forall a b. (a -> b) -> a -> b
$ [(CategoryName, [a])] -> Map CategoryName [a]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CategoryName, [a])] -> Map CategoryName [a])
-> [(CategoryName, [a])] -> Map CategoryName [a]
forall a b. (a -> b) -> a -> b
$ (ScopedFunction a -> (CategoryName, [a]))
-> [ScopedFunction a] -> [(CategoryName, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction a
f -> (ScopedFunction a -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction a
f,ScopedFunction a -> [a]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f)) [ScopedFunction a]
fs2 of
             -- For unions, we want the most general rather than the least
             -- general. Since the top level finds the least general, we can
             -- only return one match here.
             [(CategoryName, [a])
_] -> [m (ScopedFunction a)] -> m (ScopedFunction a)
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m a
forall (f :: * -> *) a. Foldable f => f (m a) -> m a
collectFirstM ([m (ScopedFunction a)] -> m (ScopedFunction a))
-> [m (ScopedFunction a)] -> m (ScopedFunction a)
forall a b. (a -> b) -> a -> b
$ (ScopedFunction a -> m (ScopedFunction a))
-> [ScopedFunction a] -> [m (ScopedFunction a)]
forall a b. (a -> b) -> [a] -> [b]
map ([ScopedFunction a] -> ScopedFunction a -> m (ScopedFunction a)
forall {m :: * -> *} {c} {c}.
(CollectErrorsM m, Show c, Show c) =>
[ScopedFunction c] -> ScopedFunction c -> m (ScopedFunction c)
tryMergeTo [ScopedFunction a]
fs2) [ScopedFunction a]
fs2 [m (ScopedFunction a)]
-> [m (ScopedFunction a)] -> [m (ScopedFunction a)]
forall a. [a] -> [a] -> [a]
++ [GeneralInstance -> [ScopedFunction a] -> m (ScopedFunction a)
forall {m :: * -> *} {a} {a} {a}.
(CollectErrorsM m, Show a, Show a) =>
a -> [a] -> m a
multipleMatchError GeneralInstance
t' [ScopedFunction a]
fs2]
             [] -> String -> m (ScopedFunction a)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction a)) -> String -> m (ScopedFunction a)
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not available for type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GeneralInstance -> String
forall a. Show a => a -> String
show GeneralInstance
t' String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
             [(CategoryName, [a])]
cs -> String
"Use an explicit 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
" for type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GeneralInstance -> String
forall a. Show a => a -> String
show GeneralInstance
t' String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> m (ScopedFunction a) -> m (ScopedFunction a)
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
!!>
               [String] -> m (ScopedFunction a)
forall (m :: * -> *) a. CollectErrorsM m => [String] -> m a
mapErrorsM (((CategoryName, [a]) -> String)
-> [(CategoryName, [a])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(CategoryName
t2,[a]
c2) -> 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]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c2) [(CategoryName, [a])]
cs)
      getFromAll :: f (m (ScopedFunction c)) -> m (ScopedFunction c)
getFromAll f (m (ScopedFunction c))
fs = do
        let (Just GeneralInstance
t') = Maybe GeneralInstance
t  -- #self will never be an intersection.
        f (m (ScopedFunction c)) -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectFirstM_ f (m (ScopedFunction c))
fs m () -> String -> m ()
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
" is not available for type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GeneralInstance -> String
forall a. Show a => a -> String
show GeneralInstance
t' String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
        [ScopedFunction c]
fs2 <- f (m (ScopedFunction c)) -> m [ScopedFunction c]
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m [a]
forall (f :: * -> *) a. Foldable f => f (m a) -> m [a]
collectAnyM f (m (ScopedFunction c))
fs
        [m (ScopedFunction c)] -> m (ScopedFunction c)
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m a
forall (f :: * -> *) a. Foldable f => f (m a) -> m a
collectFirstM ([m (ScopedFunction c)] -> m (ScopedFunction c))
-> [m (ScopedFunction c)] -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (ScopedFunction c))
-> [ScopedFunction c] -> [m (ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map ([ScopedFunction c] -> ScopedFunction c -> m (ScopedFunction c)
forall {m :: * -> *} {c} {c}.
(CollectErrorsM m, Show c, Show c) =>
[ScopedFunction c] -> ScopedFunction c -> m (ScopedFunction c)
tryMergeFrom [ScopedFunction c]
fs2) [ScopedFunction c]
fs2 [m (ScopedFunction c)]
-> [m (ScopedFunction c)] -> [m (ScopedFunction c)]
forall a. [a] -> [a] -> [a]
++ [GeneralInstance -> [ScopedFunction c] -> m (ScopedFunction c)
forall {m :: * -> *} {a} {a} {a}.
(CollectErrorsM m, Show a, Show a) =>
a -> [a] -> m a
multipleMatchError GeneralInstance
t' [ScopedFunction c]
fs2]
      getFromSingle :: GeneralInstance -> TypeInstanceOrParam -> m (ScopedFunction c)
getFromSingle GeneralInstance
t0 (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]
ff <- 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeFilter]
fs
                   Maybe [TypeFilter]
_ -> String -> m [TypeFilter]
forall a. String -> m a
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
" not found"
        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]
ff
        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]
ff
        let fs :: [m (ScopedFunction c)]
fs = (GeneralInstance -> m (ScopedFunction c))
-> [GeneralInstance] -> [m (ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map (GeneralInstance -> GeneralInstance -> m (ScopedFunction c)
getFunction GeneralInstance
t0) [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 (GeneralInstance -> DefinesInstance -> m (ScopedFunction c)
forall {m :: * -> *}.
CollectErrorsM m =>
GeneralInstance -> DefinesInstance -> m (ScopedFunction c)
checkDefine GeneralInstance
t0) [DefinesInstance]
ds
        [m (ScopedFunction c)] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectFirstM_ [m (ScopedFunction c)]
fs m () -> String -> m ()
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
        [ScopedFunction c]
fs2 <- [m (ScopedFunction c)] -> m [ScopedFunction c]
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m [a]
forall (f :: * -> *) a. Foldable f => f (m a) -> m [a]
collectAnyM [m (ScopedFunction c)]
fs
        [m (ScopedFunction c)] -> m (ScopedFunction c)
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m a
forall (f :: * -> *) a. Foldable f => f (m a) -> m a
collectFirstM ([m (ScopedFunction c)] -> m (ScopedFunction c))
-> [m (ScopedFunction c)] -> m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> m (ScopedFunction c))
-> [ScopedFunction c] -> [m (ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map ([ScopedFunction c] -> ScopedFunction c -> m (ScopedFunction c)
forall {m :: * -> *} {c} {c}.
(CollectErrorsM m, Show c, Show c) =>
[ScopedFunction c] -> ScopedFunction c -> m (ScopedFunction c)
tryMergeFrom [ScopedFunction c]
fs2) [ScopedFunction c]
fs2 [m (ScopedFunction c)]
-> [m (ScopedFunction c)] -> [m (ScopedFunction c)]
forall a. [a] -> [a] -> [a]
++ [ParamName -> [ScopedFunction c] -> m (ScopedFunction c)
forall {m :: * -> *} {a} {a} {a}.
(CollectErrorsM m, Show a, Show a) =>
a -> [a] -> m a
multipleMatchError ParamName
p [ScopedFunction c]
fs2]
      getFromSingle GeneralInstance
t0 (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
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType =
          GeneralInstance
-> CategoryName
-> Positional ParamName
-> InstanceParams
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
forall {m :: * -> *} {c}.
(CollectErrorsM m, Show c) =>
GeneralInstance
-> CategoryName
-> Positional ParamName
-> InstanceParams
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction GeneralInstance
t0 (TypeInstance -> CategoryName
tiName TypeInstance
t2) ((ValueParam c -> ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam (Positional (ValueParam c) -> Positional ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting
     (Positional (ValueParam c))
     (ProcedureContext c)
     (Positional (ValueParam c))
-> Positional (ValueParam c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Positional (ValueParam c))
  (ProcedureContext c)
  (Positional (ValueParam c))
forall c (f :: * -> *).
Functor f =>
(Positional (ValueParam c) -> f (Positional (ValueParam c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcExtParams) (TypeInstance -> InstanceParams
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
ctx ProcedureContext c
-> Getting
     (Map FunctionName (ScopedFunction c))
     (ProcedureContext c)
     (Map FunctionName (ScopedFunction c))
-> Map FunctionName (ScopedFunction c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map FunctionName (ScopedFunction c))
  (ProcedureContext c)
  (Map FunctionName (ScopedFunction c))
forall c (f :: * -> *).
Functor f =>
(Map FunctionName (ScopedFunction c)
 -> f (Map FunctionName (ScopedFunction c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcFunctions)
        -- 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
ctx ProcedureContext c
-> Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
-> CategoryMap c
forall s a. s -> Getting a s a -> a
^. Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
forall c (f :: * -> *).
Functor f =>
(CategoryMap c -> f (CategoryMap c))
-> ProcedureContext c -> f (ProcedureContext c)
pcCategories) ([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
          GeneralInstance
-> CategoryName
-> Positional ParamName
-> InstanceParams
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
forall {m :: * -> *} {c}.
(CollectErrorsM m, Show c) =>
GeneralInstance
-> CategoryName
-> Positional ParamName
-> InstanceParams
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction GeneralInstance
t0 (TypeInstance -> CategoryName
tiName TypeInstance
t2) Positional ParamName
params (TypeInstance -> InstanceParams
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 GeneralInstance
_ TypeInstanceOrParam
_ = String -> m (ScopedFunction c)
forall a. String -> m a
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 :: GeneralInstance -> DefinesInstance -> m (ScopedFunction c)
checkDefine GeneralInstance
t0 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
ctx ProcedureContext c
-> Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
-> CategoryMap c
forall s a. s -> Getting a s a -> a
^. Getting (CategoryMap c) (ProcedureContext c) (CategoryMap c)
forall c (f :: * -> *).
Functor f =>
(CategoryMap c -> f (CategoryMap c))
-> ProcedureContext c -> f (ProcedureContext c)
pcCategories) ([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
        GeneralInstance
-> CategoryName
-> Positional ParamName
-> InstanceParams
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
forall {m :: * -> *} {c}.
(CollectErrorsM m, Show c) =>
GeneralInstance
-> CategoryName
-> Positional ParamName
-> InstanceParams
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction GeneralInstance
t0 (DefinesInstance -> CategoryName
diName DefinesInstance
t2) Positional ParamName
params (DefinesInstance -> InstanceParams
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 :: GeneralInstance
-> CategoryName
-> Positional ParamName
-> InstanceParams
-> Maybe (ScopedFunction c)
-> m (ScopedFunction c)
subAndCheckFunction GeneralInstance
t0 CategoryName
t2 Positional ParamName
ps1 InstanceParams
ps2 (Just ScopedFunction c
f) = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProcedureContext c
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcDisallowInit Bool -> Bool -> Bool
&& CategoryName
t2 CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
== ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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 a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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
-> InstanceParams
-> 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 InstanceParams
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 :: ParamValues
assigned = [(ParamName, GeneralInstance)] -> ParamValues
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ParamName, GeneralInstance)]
paired
        ParamValues -> ScopedFunction c -> m (ScopedFunction c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ParamValues -> ScopedFunction c -> m (ScopedFunction c)
uncheckedSubFunction ParamValues
assigned ScopedFunction c
f m (ScopedFunction c)
-> (ScopedFunction c -> m (ScopedFunction c))
-> m (ScopedFunction c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GeneralInstance -> ScopedFunction c -> m (ScopedFunction c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> ScopedFunction c -> m (ScopedFunction c)
replaceSelfFunction (GeneralInstance -> GeneralInstance
fixTypeParams GeneralInstance
t0)
      subAndCheckFunction GeneralInstance
_ CategoryName
t2 Positional ParamName
_ InstanceParams
_ Maybe (ScopedFunction c)
_ =
        String -> m (ScopedFunction c)
forall a. String -> m a
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 -> m ()
ccCheckValueInit ProcedureContext c
ctx [c]
c (TypeInstance CategoryName
t InstanceParams
as) ExpressionType
ts
    | CategoryName
t CategoryName -> CategoryName -> Bool
forall a. Eq a => a -> a -> Bool
/= ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Category " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show (ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType) 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 -> InstanceParams -> TypeInstance
TypeInstance (ProcedureContext c
ctx ProcedureContext c
-> Getting CategoryName (ProcedureContext c) CategoryName
-> CategoryName
forall s a. s -> Getting a s a -> a
^. Getting CategoryName (ProcedureContext c) CategoryName
forall c (f :: * -> *).
Functor f =>
(CategoryName -> f CategoryName)
-> ProcedureContext c -> f (ProcedureContext c)
pcType) InstanceParams
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
      ParamValues
pa  <- ([(ParamName, GeneralInstance)] -> ParamValues)
-> m [(ParamName, GeneralInstance)] -> m ParamValues
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ParamName, GeneralInstance)] -> ParamValues
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(ParamName, GeneralInstance)] -> m ParamValues)
-> m [(ParamName, GeneralInstance)] -> m ParamValues
forall a b. (a -> b) -> a -> b
$ (ParamName -> GeneralInstance -> m (ParamName, GeneralInstance))
-> Positional ParamName
-> InstanceParams
-> 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 a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam (Positional (ValueParam c) -> Positional ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting
     (Positional (ValueParam c))
     (ProcedureContext c)
     (Positional (ValueParam c))
-> Positional (ValueParam c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Positional (ValueParam c))
  (ProcedureContext c)
  (Positional (ValueParam c))
forall c (f :: * -> *).
Functor f =>
(Positional (ValueParam c) -> f (Positional (ValueParam c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcExtParams) InstanceParams
as
      AnyTypeResolver -> ParamFilters -> TypeInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> TypeInstance -> m ()
validateTypeInstanceForCall AnyTypeResolver
r ParamFilters
allFilters TypeInstance
t'
      -- Check initializer types.
      Positional (MemberValue c)
ms <- ([MemberValue c] -> Positional (MemberValue c))
-> m [MemberValue c] -> m (Positional (MemberValue c))
forall a b. (a -> b) -> m a -> m b
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]
mapCompilerM (ParamValues -> DefinedMember c -> m (MemberValue c)
forall {m :: * -> *} {c}.
CollectErrorsM m =>
ParamValues -> DefinedMember c -> m (MemberValue c)
subSingle ParamValues
pa) (ProcedureContext c
ctx ProcedureContext c
-> Getting [DefinedMember c] (ProcedureContext c) [DefinedMember c]
-> [DefinedMember c]
forall s a. s -> Getting a s a -> a
^. Getting [DefinedMember c] (ProcedureContext c) [DefinedMember c]
forall c (f :: * -> *).
Functor f =>
([DefinedMember c] -> f [DefinedMember c])
-> ProcedureContext c -> f (ProcedureContext c)
pcMembers)
      -- Do a size comparison first so that the error message is readable.
      (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 ((MemberValue c -> ValueType)
-> Positional (MemberValue c) -> ExpressionType
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MemberValue c -> ValueType
forall c. MemberValue c -> ValueType
mvType Positional (MemberValue c)
ms) ExpressionType
ts
      (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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      where
        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 :: ParamValues -> DefinedMember c -> m (MemberValue c)
subSingle ParamValues
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 (ParamValues -> ParamName -> m GeneralInstance
forall (m :: * -> *).
ErrorContextM m =>
ParamValues -> ParamName -> m GeneralInstance
getValueForParam ParamValues
pa) ValueType
t2
          MemberValue c -> m (MemberValue c)
forall a. a -> m a
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
ctx ProcedureContext c
-> Getting
     (Map VariableName (VariableValue c))
     (ProcedureContext c)
     (Map VariableName (VariableValue c))
-> Map VariableName (VariableValue c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map VariableName (VariableValue c))
  (ProcedureContext c)
  (Map VariableName (VariableValue c))
forall c (f :: * -> *).
Functor f =>
(Map VariableName (VariableValue c)
 -> f (Map VariableName (VariableValue c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcVariables) of
           (Just (VariableValue [c]
_ SymbolScope
_ ValueType
_ (VariableHidden []))) ->
             String -> m (VariableValue c)
forall a. String -> m a
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]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++
                              String
" is hidden"
           (Just (VariableValue [c]
_ SymbolScope
_ ValueType
_ (VariableHidden [c]
c2))) ->
             String -> m (VariableValue c)
forall a. String -> m a
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]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++
                              String
" was explicitly hidden at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c2
           (Just VariableValue c
v) -> VariableValue c -> m (VariableValue c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue c
v
           Maybe (VariableValue c)
_ -> String -> m (VariableValue c)
forall a. String -> m a
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]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not defined"
  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
ctx ProcedureContext c
-> Getting
     (Map VariableName (VariableValue c))
     (ProcedureContext c)
     (Map VariableName (VariableValue c))
-> Map VariableName (VariableValue c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map VariableName (VariableValue c))
  (ProcedureContext c)
  (Map VariableName (VariableValue c))
forall c (f :: * -> *).
Functor f =>
(Map VariableName (VariableValue c)
 -> f (Map VariableName (VariableValue c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcVariables) of
          Maybe (VariableValue c)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          (Just VariableValue c
v) -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (Map VariableName (VariableValue c)
 -> Identity (Map VariableName (VariableValue c)))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(Map VariableName (VariableValue c)
 -> f (Map VariableName (VariableValue c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcVariables ((Map VariableName (VariableValue c)
  -> Identity (Map VariableName (VariableValue c)))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> Map VariableName (VariableValue c)
-> ProcedureContext c
-> ProcedureContext c
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [(VariableName, VariableValue c)]
-> Map VariableName (VariableValue c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(VariableName
n,VariableValue c
t)]
  ccSetReadOnly :: ProcedureContext c -> UsedVariable c -> m (ProcedureContext c)
ccSetReadOnly ProcedureContext c
ctx v :: UsedVariable c
v@(UsedVariable [c]
c VariableName
n) = do
    (VariableValue [c]
c2 SymbolScope
s ValueType
t VariableRule c
_) <- ProcedureContext c -> UsedVariable c -> m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> UsedVariable c -> m (VariableValue c)
ccGetVariable ProcedureContext c
ctx UsedVariable c
v
    ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (Map VariableName (VariableValue c)
 -> Identity (Map VariableName (VariableValue c)))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(Map VariableName (VariableValue c)
 -> f (Map VariableName (VariableValue c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcVariables ((Map VariableName (VariableValue c)
  -> Identity (Map VariableName (VariableValue c)))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> (Map VariableName (VariableValue c)
    -> Map VariableName (VariableValue c))
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ 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 ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c2 SymbolScope
s ValueType
t ([c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableReadOnly [c]
c))
  ccSetDeferred :: ProcedureContext c -> UsedVariable c -> m (ProcedureContext c)
ccSetDeferred ProcedureContext c
ctx v :: UsedVariable c
v@(UsedVariable [c]
c VariableName
n) = do
    (VariableValue [c]
c2 SymbolScope
_ ValueType
t VariableRule c
r) <- ProcedureContext c -> UsedVariable c -> m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> UsedVariable c -> m (VariableValue c)
ccGetVariable ProcedureContext c
ctx UsedVariable c
v
    case VariableRule c
r of
         VariableReadOnly [c]
c3 -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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]
c2 String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                  String
" cannot be marked as deferred " 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
" because it is read-only" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c3
         VariableHidden [c]
c3 -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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]
c2 String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                  String
" cannot be marked as deferred " 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
" because it is hidden" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c3
         VariableRule c
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (DeferVariable c -> Identity (DeferVariable c))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred ((DeferVariable c -> Identity (DeferVariable c))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> (DeferVariable c -> DeferVariable c)
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ VariableName -> PassedValue c -> DeferVariable c -> DeferVariable c
forall c.
VariableName -> PassedValue c -> DeferVariable c -> DeferVariable c
addDeferred VariableName
n ([c] -> ValueType -> PassedValue c
forall c. [c] -> ValueType -> PassedValue c
PassedValue [c]
c ValueType
t)
  ccSetHidden :: ProcedureContext c -> UsedVariable c -> m (ProcedureContext c)
ccSetHidden ProcedureContext c
ctx v :: UsedVariable c
v@(UsedVariable [c]
c VariableName
n) = do
    (VariableValue [c]
c2 SymbolScope
s ValueType
t VariableRule c
_) <- ProcedureContext c -> UsedVariable c -> m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> UsedVariable c -> m (VariableValue c)
ccGetVariable ProcedureContext c
ctx UsedVariable c
v
    ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (Map VariableName (VariableValue c)
 -> Identity (Map VariableName (VariableValue c)))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(Map VariableName (VariableValue c)
 -> f (Map VariableName (VariableValue c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcVariables ((Map VariableName (VariableValue c)
  -> Identity (Map VariableName (VariableValue c)))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> (Map VariableName (VariableValue c)
    -> Map VariableName (VariableValue c))
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ 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 ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c2 SymbolScope
s ValueType
t ([c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableHidden [c]
c))
  ccCheckVariableInit :: ProcedureContext c -> [UsedVariable c] -> m ()
ccCheckVariableInit ProcedureContext c
ctx [UsedVariable c]
vs
    -- Deferred variables are checked during cleanup inlining.
    | ProcedureContext c
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcInCleanup = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        case ProcedureContext c
ctx ProcedureContext c
-> Getting
     (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
-> ReturnValidation c
forall s a. s -> Getting a s a -> a
^. Getting
  (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns of
              ValidateNames Positional VariableName
_ Positional (PassedValue c)
_ DeferVariable c
na -> (UsedVariable c -> m ()) -> [UsedVariable c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (DeferVariable c -> UsedVariable c -> m ()
forall {f :: * -> *} {a} {c}.
(ErrorContextM f, Show a) =>
DeferVariable c -> UsedVariable a -> f ()
checkSingle DeferVariable c
na) [UsedVariable c]
vs
              ReturnValidation c
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (UsedVariable c -> m ()) -> [UsedVariable c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (DeferVariable c -> UsedVariable c -> m ()
forall {f :: * -> *} {a} {c}.
(ErrorContextM f, Show a) =>
DeferVariable c -> UsedVariable a -> f ()
checkSingle (DeferVariable c -> UsedVariable c -> m ())
-> DeferVariable c -> UsedVariable c -> m ()
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
-> DeferVariable c
forall s a. s -> Getting a s a -> a
^. Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred) [UsedVariable c]
vs
        where
          checkSingle :: DeferVariable c -> UsedVariable a -> f ()
checkSingle DeferVariable c
na (UsedVariable [a]
c VariableName
n) =
            Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VariableName
n VariableName -> DeferVariable c -> Bool
forall c. VariableName -> DeferVariable c -> Bool
`checkDeferred` DeferVariable c
na) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
              String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ String
"Deferred 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
" 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([String] -> Identity [String])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcOutput (([String] -> Identity [String])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [String] -> ProcedureContext c -> ProcedureContext c
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [String]
ss
  ccGetOutput :: ProcedureContext c -> m [String]
ccGetOutput = [String] -> m [String]
forall a. a -> m a
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
-> Getting [String] (ProcedureContext c) [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] (ProcedureContext c) [String]
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcOutput)
  ccClearOutput :: ProcedureContext c -> m (ProcedureContext c)
ccClearOutput ProcedureContext c
ctx = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([String] -> Identity [String])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcOutput (([String] -> Identity [String])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [String] -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String]
forall a. Monoid a => a
mempty
  ccUpdateAssigned :: ProcedureContext c -> VariableName -> m (ProcedureContext c)
ccUpdateAssigned ProcedureContext c
ctx VariableName
n = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (ReturnValidation c -> Identity (ReturnValidation c))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns ((ReturnValidation c -> Identity (ReturnValidation c))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> (ReturnValidation c -> ReturnValidation c)
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ReturnValidation c -> ReturnValidation c
forall {c}. ReturnValidation c -> ReturnValidation c
updateReturns ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (DeferVariable c -> Identity (DeferVariable c))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred ((DeferVariable c -> Identity (DeferVariable c))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> (DeferVariable c -> DeferVariable c)
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DeferVariable c -> DeferVariable c
forall {c}. DeferVariable c -> DeferVariable c
updateDeferred where
    updateReturns :: ReturnValidation c -> ReturnValidation c
updateReturns (ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts DeferVariable c
ra) = Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts (DeferVariable c -> ReturnValidation c)
-> DeferVariable c -> ReturnValidation c
forall a b. (a -> b) -> a -> b
$ VariableName
n VariableName -> DeferVariable c -> DeferVariable c
forall c. VariableName -> DeferVariable c -> DeferVariable c
`removeDeferred` DeferVariable c
ra
    updateReturns ReturnValidation c
rs                       = ReturnValidation c
rs
    updateDeferred :: DeferVariable c -> DeferVariable c
updateDeferred = (VariableName
n VariableName -> DeferVariable c -> DeferVariable c
forall c. VariableName -> DeferVariable c -> DeferVariable c
`removeDeferred`)
  ccAddUsed :: ProcedureContext c -> UsedVariable c -> m (ProcedureContext c)
ccAddUsed ProcedureContext c
ctx UsedVariable c
v
    | ProcedureContext c
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcInCleanup = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([UsedVariable c] -> Identity [UsedVariable c])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([UsedVariable c] -> f [UsedVariable c])
-> ProcedureContext c -> f (ProcedureContext c)
pcUsedVars (([UsedVariable c] -> Identity [UsedVariable c])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [UsedVariable c] -> ProcedureContext c -> ProcedureContext c
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [UsedVariable c
v]
    | Bool
otherwise          = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcedureContext c
ctx
  ccInheritStatic :: ProcedureContext c
-> [ProcedureContext c] -> m (ProcedureContext c)
ccInheritStatic ProcedureContext c
ctx [] = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcedureContext c
ctx
  ccInheritStatic ProcedureContext c
ctx [ProcedureContext c]
cs = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (ReturnValidation c -> Identity (ReturnValidation c))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns ((ReturnValidation c -> Identity (ReturnValidation c))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> ReturnValidation c -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReturnValidation c
returns ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (JumpType -> Identity JumpType)
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType ((JumpType -> Identity JumpType)
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> JumpType -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ JumpType
jump ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([UsedVariable c] -> Identity [UsedVariable c])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([UsedVariable c] -> f [UsedVariable c])
-> ProcedureContext c -> f (ProcedureContext c)
pcUsedVars (([UsedVariable c] -> Identity [UsedVariable c])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [UsedVariable c] -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [UsedVariable c]
used ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (DeferVariable c -> Identity (DeferVariable c))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred ((DeferVariable c -> Identity (DeferVariable c))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> DeferVariable c -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DeferVariable c
deferred ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([String] -> Identity [String])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces (([String] -> Identity [String])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [String] -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String]
traces where
    traces :: [String]
traces = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting [String] (ProcedureContext c) [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] (ProcedureContext c) [String]
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (ProcedureContext c -> [String])
-> [ProcedureContext c] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (ProcedureContext c
-> Getting [String] (ProcedureContext c) [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] (ProcedureContext c) [String]
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces) [ProcedureContext c]
cs)
    used :: [UsedVariable c]
used = ProcedureContext c
ctx ProcedureContext c
-> Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
-> [UsedVariable c]
forall s a. s -> Getting a s a -> a
^. Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
forall c (f :: * -> *).
Functor f =>
([UsedVariable c] -> f [UsedVariable c])
-> ProcedureContext c -> f (ProcedureContext c)
pcUsedVars [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
-> Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
-> [UsedVariable c]
forall s a. s -> Getting a s a -> a
^. Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
forall c (f :: * -> *).
Functor f =>
([UsedVariable c] -> f [UsedVariable c])
-> ProcedureContext c -> f (ProcedureContext c)
pcUsedVars) [ProcedureContext c]
cs)
    deferred :: DeferVariable c
deferred = (ProcedureContext c
ctx ProcedureContext c
-> Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
-> DeferVariable c
forall s a. s -> Getting a s a -> a
^. Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred) DeferVariable c -> DeferVariable c -> DeferVariable c
forall c. DeferVariable c -> DeferVariable c -> DeferVariable c
`followDeferred` DeferVariable c
deferred2
    (ReturnValidation c
returns,JumpType
jump) = (ReturnValidation c, JumpType)
-> (ReturnValidation c, JumpType) -> (ReturnValidation c, JumpType)
forall {b} {c}.
Ord b =>
(ReturnValidation c, b)
-> (ReturnValidation c, b) -> (ReturnValidation c, b)
combineSeries (ProcedureContext c
ctx ProcedureContext c
-> Getting
     (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
-> ReturnValidation c
forall s a. s -> Getting a s a -> a
^. Getting
  (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns,ProcedureContext c
ctx ProcedureContext c
-> Getting JumpType (ProcedureContext c) JumpType -> JumpType
forall s a. s -> Getting a s a -> a
^. Getting JumpType (ProcedureContext c) JumpType
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType) (ReturnValidation c
returns2,JumpType
jump2)
    combineSeries :: (ReturnValidation c, b)
-> (ReturnValidation c, b) -> (ReturnValidation c, b)
combineSeries (r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),b
j1) (ReturnValidation c
_,b
j2) = (ReturnValidation c
r,b -> b -> b
forall a. Ord a => a -> a -> a
max b
j1 b
j2)
    combineSeries (ReturnValidation c
_,b
j1) (r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),b
j2) = (ReturnValidation c
r,b -> b -> b
forall a. Ord a => a -> a -> a
max b
j1 b
j2)
    combineSeries (ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts DeferVariable c
ra1,b
j1) (ValidateNames Positional VariableName
_ Positional (PassedValue c)
_ DeferVariable c
ra2,b
j2) = (Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts (DeferVariable c -> ReturnValidation c)
-> DeferVariable c -> ReturnValidation c
forall a b. (a -> b) -> a -> b
$ DeferVariable c
ra1 DeferVariable c -> DeferVariable c -> DeferVariable c
forall c. DeferVariable c -> DeferVariable c -> DeferVariable c
`followDeferred` DeferVariable c
ra2,b -> b -> b
forall a. Ord a => a -> a -> a
max b
j1 b
j2)
    (DeferVariable c
deferred2,ReturnValidation c
returns2,JumpType
jump2) = ((DeferVariable c, ReturnValidation c, JumpType)
 -> (DeferVariable c, ReturnValidation c, JumpType)
 -> (DeferVariable c, ReturnValidation c, JumpType))
-> (DeferVariable c, ReturnValidation c, JumpType)
-> [(DeferVariable c, ReturnValidation c, JumpType)]
-> (DeferVariable c, ReturnValidation c, JumpType)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DeferVariable c, ReturnValidation c, JumpType)
-> (DeferVariable c, ReturnValidation c, JumpType)
-> (DeferVariable c, ReturnValidation c, JumpType)
forall {c} {c}.
(DeferVariable c, ReturnValidation c, JumpType)
-> (DeferVariable c, ReturnValidation c, JumpType)
-> (DeferVariable c, ReturnValidation c, JumpType)
combineParallel (DeferVariable c
forall c. DeferVariable c
emptyDeferred,Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
ValidateNames ([VariableName] -> Positional VariableName
forall a. [a] -> Positional a
Positional []) ([PassedValue c] -> Positional (PassedValue c)
forall a. [a] -> Positional a
Positional []) DeferVariable c
forall c. DeferVariable c
emptyDeferred,JumpType
JumpMax) ([(DeferVariable c, ReturnValidation c, JumpType)]
 -> (DeferVariable c, ReturnValidation c, JumpType))
-> [(DeferVariable c, ReturnValidation c, JumpType)]
-> (DeferVariable c, ReturnValidation c, JumpType)
forall a b. (a -> b) -> a -> b
$
      [DeferVariable c]
-> [ReturnValidation c]
-> [JumpType]
-> [(DeferVariable c, ReturnValidation c, JumpType)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 ((ProcedureContext c -> DeferVariable c)
-> [ProcedureContext c] -> [DeferVariable c]
forall a b. (a -> b) -> [a] -> [b]
map (ProcedureContext c
-> Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
-> DeferVariable c
forall s a. s -> Getting a s a -> a
^. Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred) [ProcedureContext c]
cs) ((ProcedureContext c -> ReturnValidation c)
-> [ProcedureContext c] -> [ReturnValidation c]
forall a b. (a -> b) -> [a] -> [b]
map (ProcedureContext c
-> Getting
     (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
-> ReturnValidation c
forall s a. s -> Getting a s a -> a
^. Getting
  (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns) [ProcedureContext c]
cs) ((ProcedureContext c -> JumpType)
-> [ProcedureContext c] -> [JumpType]
forall a b. (a -> b) -> [a] -> [b]
map (ProcedureContext c
-> Getting JumpType (ProcedureContext c) JumpType -> JumpType
forall s a. s -> Getting a s a -> a
^. Getting JumpType (ProcedureContext c) JumpType
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType) [ProcedureContext c]
cs)
    -- Ignore a branch if it jumps to a higher scope.
    combineParallel :: (DeferVariable c, ReturnValidation c, JumpType)
-> (DeferVariable c, ReturnValidation c, JumpType)
-> (DeferVariable c, ReturnValidation c, JumpType)
combineParallel (DeferVariable c
_,ReturnValidation c
_,JumpType
j1) (DeferVariable c
da2,ReturnValidation c
r,JumpType
j2) | JumpType
j1 JumpType -> JumpType -> Bool
forall a. Ord a => a -> a -> Bool
> JumpType
NextStatement = (DeferVariable c
da2,ReturnValidation c
r,JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
    combineParallel (DeferVariable c
da1,ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts DeferVariable c
ra1,JumpType
j1) (DeferVariable c
da2,ValidateNames Positional VariableName
_ Positional (PassedValue c)
_ DeferVariable c
ra2,JumpType
j2) = ([DeferVariable c] -> DeferVariable c
forall c. [DeferVariable c] -> DeferVariable c
branchDeferred [DeferVariable c
da1,DeferVariable c
da2],Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts (DeferVariable c -> ReturnValidation c)
-> DeferVariable c -> ReturnValidation c
forall a b. (a -> b) -> a -> b
$ [DeferVariable c] -> DeferVariable c
forall c. [DeferVariable c] -> DeferVariable c
branchDeferred [DeferVariable c
ra1,DeferVariable c
ra2],JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
    combineParallel (DeferVariable c
da1,r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),JumpType
j1) (DeferVariable c
da2,ReturnValidation c
_,JumpType
j2) = ([DeferVariable c] -> DeferVariable c
forall c. [DeferVariable c] -> DeferVariable c
branchDeferred [DeferVariable c
da1,DeferVariable c
da2],ReturnValidation c
r,JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
    combineParallel (DeferVariable c
da1,ReturnValidation c
_,JumpType
j1) (DeferVariable c
da2,r :: ReturnValidation c
r@(ValidatePositions Positional (PassedValue c)
_),JumpType
j2) = ([DeferVariable c] -> DeferVariable c
forall c. [DeferVariable c] -> DeferVariable c
branchDeferred [DeferVariable c
da1,DeferVariable c
da2],ReturnValidation c
r,JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
min JumpType
j1 JumpType
j2)
  ccInheritDeferred :: ProcedureContext c -> DeferVariable c -> m (ProcedureContext c)
ccInheritDeferred ProcedureContext c
ctx DeferVariable c
ds = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (DeferVariable c -> Identity (DeferVariable c))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred ((DeferVariable c -> Identity (DeferVariable c))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> DeferVariable c -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DeferVariable c
deferred where
    deferred :: DeferVariable c
deferred = (ProcedureContext c
ctx ProcedureContext c
-> Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
-> DeferVariable c
forall s a. s -> Getting a s a -> a
^. Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred) DeferVariable c -> DeferVariable c -> DeferVariable c
forall c. DeferVariable c -> DeferVariable c -> DeferVariable c
`followDeferred` DeferVariable c
ds
  ccInheritUsed :: ProcedureContext c -> ProcedureContext c -> m (ProcedureContext c)
ccInheritUsed ProcedureContext c
ctx ProcedureContext c
ctx2 = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([UsedVariable c] -> Identity [UsedVariable c])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([UsedVariable c] -> f [UsedVariable c])
-> ProcedureContext c -> f (ProcedureContext c)
pcUsedVars (([UsedVariable c] -> Identity [UsedVariable c])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [UsedVariable c] -> ProcedureContext c -> ProcedureContext c
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ (ProcedureContext c
ctx2 ProcedureContext c
-> Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
-> [UsedVariable c]
forall s a. s -> Getting a s a -> a
^. Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
forall c (f :: * -> *).
Functor f =>
([UsedVariable c] -> f [UsedVariable c])
-> ProcedureContext c -> f (ProcedureContext c)
pcUsedVars)
  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
ctx ProcedureContext c
-> Getting
     (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
-> ReturnValidation c
forall s a. s -> Getting a s a -> a
^. Getting
  (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns)
    ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (ReturnValidation c -> Identity (ReturnValidation c))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns ((ReturnValidation c -> Identity (ReturnValidation c))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> ReturnValidation c -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReturnValidation c
returns ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (JumpType -> Identity JumpType)
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType ((JumpType -> Identity JumpType)
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> JumpType -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ JumpType
JumpReturn
    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 a b. (a -> b) -> Positional a -> Positional b
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 a. a -> m a
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 DeferVariable 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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
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 ()
mapCompilerM_ (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)
 -> [(VariableName, PassedValue c)])
-> Map VariableName (PassedValue c)
-> [(VariableName, PassedValue c)]
forall a b. (a -> b) -> a -> b
$ DeferVariable c -> Map VariableName (PassedValue c)
forall c. DeferVariable c -> Map VariableName (PassedValue c)
dvDeferred DeferVariable c
ra
        ReturnValidation c -> m (ReturnValidation c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
forall c.
Positional VariableName
-> Positional (PassedValue c)
-> DeferVariable c
-> ReturnValidation c
ValidateNames Positional VariableName
ns Positional (PassedValue c)
ts DeferVariable c
forall c. DeferVariable c
emptyDeferred)
      alwaysError :: (a, b) -> m a
alwaysError (a
n,b
_) = String -> m a
forall a. 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 a. a -> m a
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
-> Getting [ReturnVariable] (ProcedureContext c) [ReturnVariable]
-> [ReturnVariable]
forall s a. s -> Getting a s a -> a
^. Getting [ReturnVariable] (ProcedureContext c) [ReturnVariable]
forall c (f :: * -> *).
Functor f =>
([ReturnVariable] -> f [ReturnVariable])
-> ProcedureContext c -> f (ProcedureContext c)
pcPrimNamed)
  ccIsUnreachable :: ProcedureContext c -> m Bool
ccIsUnreachable ProcedureContext c
ctx
    | ProcedureContext c
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcInCleanup = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting JumpType (ProcedureContext c) JumpType -> JumpType
forall s a. s -> Getting a s a -> a
^. Getting JumpType (ProcedureContext c) JumpType
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType JumpType -> JumpType -> Bool
forall a. Ord a => a -> a -> Bool
> JumpType
JumpReturn
    | Bool
otherwise          = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting JumpType (ProcedureContext c) JumpType -> JumpType
forall s a. s -> Getting a s a -> a
^. Getting JumpType (ProcedureContext c) JumpType
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType JumpType -> JumpType -> Bool
forall a. Ord a => a -> a -> Bool
> JumpType
NextStatement
  ccIsNamedReturns :: ProcedureContext c -> m Bool
ccIsNamedReturns = Bool -> m Bool
forall a. a -> m a
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
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcIsNamed)
  ccSetJumpType :: ProcedureContext c -> [c] -> JumpType -> m (ProcedureContext c)
ccSetJumpType ProcedureContext c
ctx [c]
c JumpType
j
    | ProcedureContext c
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcInCleanup Bool -> Bool -> Bool
&& JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpBreak =
        String -> m (ProcedureContext c)
forall a. String -> m a
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
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcInCleanup Bool -> Bool -> Bool
&& JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpContinue =
        String -> m (ProcedureContext c)
forall a. String -> m a
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
ctx ProcedureContext c
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcInCleanup Bool -> Bool -> Bool
&& JumpType
j JumpType -> JumpType -> Bool
forall a. Eq a => a -> a -> Bool
== JumpType
JumpReturn =
        String -> m (ProcedureContext c)
forall a. String -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (JumpType -> Identity JumpType)
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType ((JumpType -> Identity JumpType)
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> (JumpType -> JumpType)
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ JumpType -> JumpType -> JumpType
forall a. Ord a => a -> a -> a
max JumpType
j
  ccStartLoop :: ProcedureContext c -> LoopSetup [String] -> m (ProcedureContext c)
ccStartLoop ProcedureContext c
ctx LoopSetup [String]
l = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (LoopSetup [String] -> Identity (LoopSetup [String]))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(LoopSetup [String] -> f (LoopSetup [String]))
-> ProcedureContext c -> f (ProcedureContext c)
pcLoopSetup ((LoopSetup [String] -> Identity (LoopSetup [String]))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> LoopSetup [String] -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LoopSetup [String]
l ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([Maybe (CleanupBlock c [String])]
 -> Identity [Maybe (CleanupBlock c [String])])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([Maybe (CleanupBlock c [String])]
 -> f [Maybe (CleanupBlock c [String])])
-> ProcedureContext c -> f (ProcedureContext c)
pcCleanupBlocks (([Maybe (CleanupBlock c [String])]
  -> Identity [Maybe (CleanupBlock c [String])])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> ([Maybe (CleanupBlock c [String])]
    -> [Maybe (CleanupBlock c [String])])
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (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]
:)
  ccGetLoop :: ProcedureContext c -> m (LoopSetup [String])
ccGetLoop = LoopSetup [String] -> m (LoopSetup [String])
forall a. a -> m a
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
-> Getting
     (LoopSetup [String]) (ProcedureContext c) (LoopSetup [String])
-> LoopSetup [String]
forall s a. s -> Getting a s a -> a
^. Getting
  (LoopSetup [String]) (ProcedureContext c) (LoopSetup [String])
forall c (f :: * -> *).
Functor f =>
(LoopSetup [String] -> f (LoopSetup [String]))
-> ProcedureContext c -> f (ProcedureContext c)
pcLoopSetup)
  ccStartCleanup :: ProcedureContext c -> [c] -> m (ProcedureContext c)
ccStartCleanup ProcedureContext c
ctx [c]
c = do
    let vars :: Map VariableName (VariableValue c)
vars = ReturnValidation c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall {c}.
ReturnValidation c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
protectReturns (ProcedureContext c
ctx ProcedureContext c
-> Getting
     (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
-> ReturnValidation c
forall s a. s -> Getting a s a -> a
^. Getting
  (ReturnValidation c) (ProcedureContext c) (ReturnValidation c)
forall c (f :: * -> *).
Functor f =>
(ReturnValidation c -> f (ReturnValidation c))
-> ProcedureContext c -> f (ProcedureContext c)
pcReturns) (ProcedureContext c
ctx ProcedureContext c
-> Getting
     (Map VariableName (VariableValue c))
     (ProcedureContext c)
     (Map VariableName (VariableValue c))
-> Map VariableName (VariableValue c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map VariableName (VariableValue c))
  (ProcedureContext c)
  (Map VariableName (VariableValue c))
forall c (f :: * -> *).
Functor f =>
(Map VariableName (VariableValue c)
 -> f (Map VariableName (VariableValue c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcVariables)
    ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (Map VariableName (VariableValue c)
 -> Identity (Map VariableName (VariableValue c)))
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(Map VariableName (VariableValue c)
 -> f (Map VariableName (VariableValue c)))
-> ProcedureContext c -> f (ProcedureContext c)
pcVariables ((Map VariableName (VariableValue c)
  -> Identity (Map VariableName (VariableValue c)))
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> Map VariableName (VariableValue c)
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map VariableName (VariableValue c)
vars ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcInCleanup ((Bool -> Identity Bool)
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> Bool -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True where
    protectReturns :: ReturnValidation c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
protectReturns (ValidateNames Positional VariableName
ns Positional (PassedValue c)
_ DeferVariable 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 a b. (a -> b -> b) -> b -> [a] -> b
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}.
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]
c2 s :: SymbolScope
s@SymbolScope
LocalScope ValueType
t VariableRule c
_) -> 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 -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c2 SymbolScope
s ValueType
t ([c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableReadOnly [c]
c)) 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([Maybe (CleanupBlock c [String])]
 -> Identity [Maybe (CleanupBlock c [String])])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([Maybe (CleanupBlock c [String])]
 -> f [Maybe (CleanupBlock c [String])])
-> ProcedureContext c -> f (ProcedureContext c)
pcCleanupBlocks (([Maybe (CleanupBlock c [String])]
  -> Identity [Maybe (CleanupBlock c [String])])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> ([Maybe (CleanupBlock c [String])]
    -> [Maybe (CleanupBlock c [String])])
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (CleanupBlock c [String] -> Maybe (CleanupBlock c [String])
forall a. a -> Maybe a
Just CleanupBlock c [String]
cleanupMaybe (CleanupBlock c [String])
-> [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall a. a -> [a] -> [a]
:) ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([String] -> Identity [String])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces (([String] -> Identity [String])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [String] -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String]
traces where
    traces :: [String]
traces = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> Getting [String] (ProcedureContext c) [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] (ProcedureContext c) [String]
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ProcedureContext c
ctx2 ProcedureContext c
-> Getting [String] (ProcedureContext c) [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] (ProcedureContext c) [String]
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces
    cleanup :: CleanupBlock c [String]
cleanup = [String]
-> DeferVariable c
-> [UsedVariable c]
-> JumpType
-> Set CategoryName
-> CleanupBlock c [String]
forall c s.
s
-> DeferVariable c
-> [UsedVariable c]
-> JumpType
-> Set CategoryName
-> CleanupBlock c s
CleanupBlock (ProcedureContext c
ctx2 ProcedureContext c
-> Getting [String] (ProcedureContext c) [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] (ProcedureContext c) [String]
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcOutput) (ProcedureContext c
ctx2 ProcedureContext c
-> Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
-> DeferVariable c
forall s a. s -> Getting a s a -> a
^. Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred) (ProcedureContext c
ctx2 ProcedureContext c
-> Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
-> [UsedVariable c]
forall s a. s -> Getting a s a -> a
^. Getting [UsedVariable c] (ProcedureContext c) [UsedVariable c]
forall c (f :: * -> *).
Functor f =>
([UsedVariable c] -> f [UsedVariable c])
-> ProcedureContext c -> f (ProcedureContext c)
pcUsedVars) (ProcedureContext c
ctx2 ProcedureContext c
-> Getting JumpType (ProcedureContext c) JumpType -> JumpType
forall s a. s -> Getting a s a -> a
^. Getting JumpType (ProcedureContext c) JumpType
forall c (f :: * -> *).
Functor f =>
(JumpType -> f JumpType)
-> ProcedureContext c -> f (ProcedureContext c)
pcJumpType) (ProcedureContext c
ctx2 ProcedureContext c
-> Getting
     (Set CategoryName) (ProcedureContext c) (Set CategoryName)
-> Set CategoryName
forall s a. s -> Getting a s a -> a
^. Getting (Set CategoryName) (ProcedureContext c) (Set CategoryName)
forall c (f :: * -> *).
Functor f =>
(Set CategoryName -> f (Set CategoryName))
-> ProcedureContext c -> f (ProcedureContext c)
pcRequiredTypes)
  ccGetCleanup :: ProcedureContext c -> JumpType -> m (CleanupBlock c [String])
ccGetCleanup ProcedureContext c
ctx JumpType
j = CleanupBlock c [String] -> m (CleanupBlock c [String])
forall a. a -> m a
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
ctx ProcedureContext c
-> Getting
     [Maybe (CleanupBlock c [String])]
     (ProcedureContext c)
     [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall s a. s -> Getting a s a -> a
^. Getting
  [Maybe (CleanupBlock c [String])]
  (ProcedureContext c)
  [Maybe (CleanupBlock c [String])]
forall c (f :: * -> *).
Functor f =>
([Maybe (CleanupBlock c [String])]
 -> f [Maybe (CleanupBlock c [String])])
-> ProcedureContext c -> f (ProcedureContext c)
pcCleanupBlocks 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 {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
ctx ProcedureContext c
-> Getting
     [Maybe (CleanupBlock c [String])]
     (ProcedureContext c)
     [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall s a. s -> Getting a s a -> a
^. Getting
  [Maybe (CleanupBlock c [String])]
  (ProcedureContext c)
  [Maybe (CleanupBlock c [String])]
forall c (f :: * -> *).
Functor f =>
([Maybe (CleanupBlock c [String])]
 -> f [Maybe (CleanupBlock c [String])])
-> ProcedureContext c -> f (ProcedureContext c)
pcCleanupBlocks
      | 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 {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
ctx ProcedureContext c
-> Getting
     [Maybe (CleanupBlock c [String])]
     (ProcedureContext c)
     [Maybe (CleanupBlock c [String])]
-> [Maybe (CleanupBlock c [String])]
forall s a. s -> Getting a s a -> a
^. Getting
  [Maybe (CleanupBlock c [String])]
  (ProcedureContext c)
  [Maybe (CleanupBlock c [String])]
forall c (f :: * -> *).
Functor f =>
([Maybe (CleanupBlock c [String])]
 -> f [Maybe (CleanupBlock c [String])])
-> ProcedureContext c -> f (ProcedureContext c)
pcCleanupBlocks
      | 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]
-> DeferVariable c
-> [UsedVariable c]
-> JumpType
-> Set CategoryName
-> CleanupBlock c [a]
forall c s.
s
-> DeferVariable c
-> [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)
                              ((DeferVariable c -> DeferVariable c -> DeferVariable c)
-> DeferVariable c -> [DeferVariable c] -> DeferVariable c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DeferVariable c -> DeferVariable c -> DeferVariable c
forall c. DeferVariable c -> DeferVariable c -> DeferVariable c
followDeferred (ProcedureContext c
ctx ProcedureContext c
-> Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
-> DeferVariable c
forall s a. s -> Getting a s a -> a
^. Getting (DeferVariable c) (ProcedureContext c) (DeferVariable c)
forall c (f :: * -> *).
Functor f =>
(DeferVariable c -> f (DeferVariable c))
-> ProcedureContext c -> f (ProcedureContext c)
pcDeferred) ([DeferVariable c] -> DeferVariable c)
-> [DeferVariable c] -> DeferVariable c
forall a b. (a -> b) -> a -> b
$ (CleanupBlock c [a] -> DeferVariable c)
-> [CleanupBlock c [a]] -> [DeferVariable c]
forall a b. (a -> b) -> [a] -> [b]
map CleanupBlock c [a] -> DeferVariable c
forall c s. CleanupBlock c s -> DeferVariable c
csDeferred [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 a b. (a -> b -> b) -> b -> [a] -> b
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 -> Map MacroName (Expression c) -> Maybe (Expression c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` (ProcedureContext c
ctx ProcedureContext c
-> Getting
     (Map MacroName (Expression c))
     (ProcedureContext c)
     (Map MacroName (Expression c))
-> Map MacroName (Expression c)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map MacroName (Expression c))
  (ProcedureContext c)
  (Map MacroName (Expression c))
forall c (f :: * -> *).
Functor f =>
(ExprMap c -> f (ExprMap c))
-> ProcedureContext c -> f (ProcedureContext c)
pcExprMap) of
         Maybe (Expression c)
Nothing -> String -> m (Expression c)
forall a. String -> m a
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
ctx ProcedureContext c
-> Getting
     [(MacroName, [c])] (ProcedureContext c) [(MacroName, [c])]
-> [(MacroName, [c])]
forall s a. s -> Getting a s a -> a
^. Getting [(MacroName, [c])] (ProcedureContext c) [(MacroName, [c])]
forall c (f :: * -> *).
Functor f =>
([(MacroName, [c])] -> f [(MacroName, [c])])
-> ProcedureContext c -> f (ProcedureContext c)
pcReservedMacros) [(MacroName
n,[c]
c)]
           Expression c -> m (Expression c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Expression c
e
    where
      checkReserved :: [(MacroName, [a])] -> [(MacroName, [a])] -> m ()
checkReserved [] [(MacroName, [a])]
_ = () -> m ()
forall a. a -> m a
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 ()
mapCompilerM_ (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 a. 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([(MacroName, [c])] -> Identity [(MacroName, [c])])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([(MacroName, [c])] -> f [(MacroName, [c])])
-> ProcedureContext c -> f (ProcedureContext c)
pcReservedMacros (([(MacroName, [c])] -> Identity [(MacroName, [c])])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> ([(MacroName, [c])] -> [(MacroName, [c])])
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((MacroName
n,[c]
c)(MacroName, [c]) -> [(MacroName, [c])] -> [(MacroName, [c])]
forall a. a -> [a] -> [a]
:)
  ccReleaseExprMacro :: ProcedureContext c -> [c] -> MacroName -> m (ProcedureContext c)
ccReleaseExprMacro ProcedureContext c
ctx [c]
_ MacroName
n = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([(MacroName, [c])] -> Identity [(MacroName, [c])])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([(MacroName, [c])] -> f [(MacroName, [c])])
-> ProcedureContext c -> f (ProcedureContext c)
pcReservedMacros (([(MacroName, [c])] -> Identity [(MacroName, [c])])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> ([(MacroName, [c])] -> [(MacroName, [c])])
-> ProcedureContext c
-> ProcedureContext c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (((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))
  ccSetNoTrace :: ProcedureContext c -> Bool -> m (ProcedureContext c)
ccSetNoTrace ProcedureContext c
ctx Bool
t = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcNoTrace ((Bool -> Identity Bool)
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> Bool -> ProcedureContext c -> ProcedureContext c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
t
  ccGetNoTrace :: ProcedureContext c -> m Bool
ccGetNoTrace = Bool -> m Bool
forall a. a -> m a
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
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcNoTrace)
  ccGetTestsOnly :: ProcedureContext c -> m Bool
ccGetTestsOnly = Bool -> m Bool
forall a. a -> m a
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
-> Getting Bool (ProcedureContext c) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ProcedureContext c) Bool
forall c (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> ProcedureContext c -> f (ProcedureContext c)
pcTestsOnly)
  ccAddTrace :: ProcedureContext c -> String -> m (ProcedureContext c)
ccAddTrace ProcedureContext c
ctx String
"" = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcedureContext c
ctx
  ccAddTrace ProcedureContext c
ctx String
t = ProcedureContext c -> m (ProcedureContext c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c -> m (ProcedureContext c)
forall a b. (a -> b) -> a -> b
$ ProcedureContext c
ctx ProcedureContext c
-> (ProcedureContext c -> ProcedureContext c) -> ProcedureContext c
forall a b. a -> (a -> b) -> b
& ([String] -> Identity [String])
-> ProcedureContext c -> Identity (ProcedureContext c)
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces (([String] -> Identity [String])
 -> ProcedureContext c -> Identity (ProcedureContext c))
-> [String] -> ProcedureContext c -> ProcedureContext c
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [String
t]
  ccGetTraces :: ProcedureContext c -> m [String]
ccGetTraces = [String] -> m [String]
forall a. a -> m a
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
-> Getting [String] (ProcedureContext c) [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] (ProcedureContext c) [String]
forall c (f :: * -> *).
Functor f =>
([String] -> f [String])
-> ProcedureContext c -> f (ProcedureContext c)
pcTraces)
  ccCanForward :: ProcedureContext c -> [ParamName] -> [VariableName] -> m Bool
ccCanForward ProcedureContext c
ctx [ParamName]
ps [VariableName]
as = Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
-> m Bool
forall {m :: * -> *} {a} {c}.
CollectErrorsM m =>
Maybe (Positional ParamName, Positional (a, InputValue c))
-> m Bool
handle (ProcedureContext c
ctx ProcedureContext c
-> Getting
     (Maybe
        (Positional ParamName,
         Positional (Maybe (CallArgLabel c), InputValue c)))
     (ProcedureContext c)
     (Maybe
        (Positional ParamName,
         Positional (Maybe (CallArgLabel c), InputValue c)))
-> Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c)))
  (ProcedureContext c)
  (Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c)))
forall c (f :: * -> *).
Functor f =>
(Maybe
   (Positional ParamName,
    Positional (Maybe (CallArgLabel c), InputValue c))
 -> f (Maybe
         (Positional ParamName,
          Positional (Maybe (CallArgLabel c), InputValue c))))
-> ProcedureContext c -> f (ProcedureContext c)
pcParentCall) where
    nameOrError :: InputValue c -> m VariableName
nameOrError (InputValue [c]
_ VariableName
n) = VariableName -> m VariableName
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableName
n
    nameOrError InputValue c
_                = m VariableName
forall (m :: * -> *) a. CollectErrorsM m => m a
emptyErrorM
    handle :: Maybe (Positional ParamName, Positional (a, InputValue c))
-> m Bool
handle Maybe (Positional ParamName, Positional (a, InputValue c))
Nothing = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    handle (Just (Positional ParamName
ps0,Positional (a, InputValue c)
as0)) = [m Bool] -> m Bool
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m a
forall (f :: * -> *) a. Foldable f => f (m a) -> m a
collectFirstM [Positional ParamName -> Positional (a, InputValue c) -> m Bool
forall {m :: * -> *} {a} {c}.
CollectErrorsM m =>
Positional ParamName -> Positional (a, InputValue c) -> m Bool
checkMatch Positional ParamName
ps0 Positional (a, InputValue c)
as0,Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False]
    checkMatch :: Positional ParamName -> Positional (a, InputValue c) -> m Bool
checkMatch Positional ParamName
ps0 Positional (a, InputValue c)
as0 = do
      Positional VariableName
as0' <- ([VariableName] -> Positional VariableName)
-> m [VariableName] -> m (Positional VariableName)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VariableName] -> Positional VariableName
forall a. [a] -> Positional a
Positional (m [VariableName] -> m (Positional VariableName))
-> m [VariableName] -> m (Positional VariableName)
forall a b. (a -> b) -> a -> b
$ ((a, InputValue c) -> m VariableName)
-> [(a, InputValue c)] -> m [VariableName]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (InputValue c -> m VariableName
forall {m :: * -> *} {c}.
CollectErrorsM m =>
InputValue c -> m VariableName
nameOrError (InputValue c -> m VariableName)
-> ((a, InputValue c) -> InputValue c)
-> (a, InputValue c)
-> m VariableName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, InputValue c) -> InputValue c
forall a b. (a, b) -> b
snd) ([(a, InputValue c)] -> m [VariableName])
-> [(a, InputValue c)] -> m [VariableName]
forall a b. (a -> b) -> a -> b
$ Positional (a, InputValue c) -> [(a, InputValue c)]
forall a. Positional a -> [a]
pValues Positional (a, InputValue c)
as0
      (ParamName -> ParamName -> m ())
-> Positional ParamName -> Positional ParamName -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ ParamName -> ParamName -> m ()
forall {a} {m :: * -> *}.
(Eq a, CollectErrorsM m) =>
a -> a -> m ()
equalOrError Positional ParamName
ps0 ([ParamName] -> Positional ParamName
forall a. [a] -> Positional a
Positional [ParamName]
ps)
      (VariableName -> VariableName -> m ())
-> Positional VariableName -> Positional VariableName -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ VariableName -> VariableName -> m ()
forall {a} {m :: * -> *}.
(Eq a, CollectErrorsM m) =>
a -> a -> m ()
equalOrError Positional VariableName
as0' ([VariableName] -> Positional VariableName
forall a. [a] -> Positional a
Positional [VariableName]
as)
      Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    equalOrError :: a -> a -> m ()
equalOrError a
x a
y
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = m ()
forall (m :: * -> *) a. CollectErrorsM m => m a
emptyErrorM
  ccDelegateArgs :: ProcedureContext c
-> m (Positional (Maybe (CallArgLabel c), VariableName))
ccDelegateArgs ProcedureContext c
ctx = Maybe
  (Positional ParamName,
   Positional (Maybe (CallArgLabel c), InputValue c))
-> m (Positional (Maybe (CallArgLabel c), VariableName))
forall {m :: * -> *} {a} {a} {a}.
(CollectErrorsM m, Show a) =>
Maybe (a, Positional (a, InputValue a))
-> m (Positional (a, VariableName))
handle (ProcedureContext c
ctx ProcedureContext c
-> Getting
     (Maybe
        (Positional ParamName,
         Positional (Maybe (CallArgLabel c), InputValue c)))
     (ProcedureContext c)
     (Maybe
        (Positional ParamName,
         Positional (Maybe (CallArgLabel c), InputValue c)))
-> Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c)))
  (ProcedureContext c)
  (Maybe
     (Positional ParamName,
      Positional (Maybe (CallArgLabel c), InputValue c)))
forall c (f :: * -> *).
Functor f =>
(Maybe
   (Positional ParamName,
    Positional (Maybe (CallArgLabel c), InputValue c))
 -> f (Maybe
         (Positional ParamName,
          Positional (Maybe (CallArgLabel c), InputValue c))))
-> ProcedureContext c -> f (ProcedureContext c)
pcParentCall) where
    nameOrError :: (a, InputValue a) -> m (a, VariableName)
nameOrError (a
l,InputValue [a]
_ VariableName
n) = (a, VariableName) -> m (a, VariableName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
l,VariableName
n)
    nameOrError (a
_,DiscardInput [a]
c) = String -> m (a, VariableName)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (a, VariableName)) -> String -> m (a, VariableName)
forall a b. (a -> b) -> a -> b
$ String
"Delegation is not allowed with ignored args" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
    handle :: Maybe (a, Positional (a, InputValue a))
-> m (Positional (a, VariableName))
handle Maybe (a, Positional (a, InputValue a))
Nothing = String -> m (Positional (a, VariableName))
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Delegation is only allowed within function calls"
    handle (Just (a
_,Positional (a, InputValue a)
as0)) = ([(a, VariableName)] -> Positional (a, VariableName))
-> m [(a, VariableName)] -> m (Positional (a, VariableName))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, VariableName)] -> Positional (a, VariableName)
forall a. [a] -> Positional a
Positional (m [(a, VariableName)] -> m (Positional (a, VariableName)))
-> m [(a, VariableName)] -> m (Positional (a, VariableName))
forall a b. (a -> b) -> a -> b
$ ((a, InputValue a) -> m (a, VariableName))
-> [(a, InputValue a)] -> m [(a, VariableName)]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (a, InputValue a) -> m (a, VariableName)
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a) =>
(a, InputValue a) -> m (a, VariableName)
nameOrError ([(a, InputValue a)] -> m [(a, VariableName)])
-> [(a, InputValue a)] -> m [(a, VariableName)]
forall a b. (a -> b) -> a -> b
$ Positional (a, InputValue a) -> [(a, InputValue a)]
forall a. Positional a -> [a]
pValues Positional (a, InputValue a)
as0

updateReturnVariables :: (Show c, CollectErrorsM m) =>
  (Map.Map VariableName (VariableValue c)) ->
  Positional (PassedValue c) -> ReturnValues c ->
  m (Map.Map VariableName (VariableValue c))
updateReturnVariables :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName (VariableValue c)
-> Positional (PassedValue c)
-> ReturnValues c
-> m (Map VariableName (VariableValue c))
updateReturnVariables Map VariableName (VariableValue c)
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 a. a -> m a
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 a b. (a -> b -> b) -> b -> [a] -> b
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 a. a -> m a
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 a. a -> m 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 -> VariableRule a -> VariableValue a
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [a]
c SymbolScope
LocalScope ValueType
t VariableRule a
forall c. VariableRule c
VariableDefault) Map VariableName (VariableValue a)
va'
               (Just VariableValue a
v) -> String -> m (Map VariableName (VariableValue a))
forall a. String -> m 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, Maybe (CallArgLabel c)) -> ArgValues c ->
  m (Map.Map VariableName (VariableValue c))
updateArgVariables :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName (VariableValue c)
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> ArgValues c
-> m (Map VariableName (VariableValue c))
updateArgVariables Map VariableName (VariableValue c)
ma Positional (PassedValue c, Maybe (CallArgLabel c))
as1 ArgValues c
as2 = do
  [((PassedValue c, Maybe (CallArgLabel c)), InputValue c)]
as <- ((PassedValue c, Maybe (CallArgLabel c))
 -> InputValue c
 -> m ((PassedValue c, Maybe (CallArgLabel c)), InputValue c))
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (InputValue c)
-> m [((PassedValue c, Maybe (CallArgLabel 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, Maybe (CallArgLabel c))
-> InputValue c
-> m ((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair Positional (PassedValue c, Maybe (CallArgLabel c))
as1 (ArgValues c -> Positional (InputValue c)
forall c. ArgValues c -> Positional (InputValue c)
avNames ArgValues c
as2)
  let as' :: [((PassedValue c, Maybe (CallArgLabel c)), InputValue c)]
as' = (((PassedValue c, Maybe (CallArgLabel c)), InputValue c) -> Bool)
-> [((PassedValue c, Maybe (CallArgLabel c)), InputValue c)]
-> [((PassedValue c, Maybe (CallArgLabel c)), InputValue c)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
    -> Bool)
-> ((PassedValue c, Maybe (CallArgLabel 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, Maybe (CallArgLabel c)), InputValue c)
    -> InputValue c)
-> ((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
-> InputValue c
forall a b. (a, b) -> b
snd) [((PassedValue c, Maybe (CallArgLabel c)), InputValue c)]
as
  (Map VariableName (VariableValue c)
 -> ((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
 -> m (Map VariableName (VariableValue c)))
-> Map VariableName (VariableValue c)
-> [((PassedValue c, Maybe (CallArgLabel c)), InputValue c)]
-> m (Map VariableName (VariableValue c))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map VariableName (VariableValue c)
-> ((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
-> m (Map VariableName (VariableValue c))
forall {m :: * -> *} {c} {c} {c}.
(ErrorContextM m, Show c, Show c) =>
Map VariableName (VariableValue c)
-> ((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
-> m (Map VariableName (VariableValue c))
update Map VariableName (VariableValue c)
ma [((PassedValue c, Maybe (CallArgLabel c)), InputValue c)]
as' where
    checkName :: Maybe (CallArgLabel c) -> InputValue a -> m ()
checkName (Just CallArgLabel c
l) (InputValue [a]
c (VariableName String
n))
      | CallArgLabel c
l CallArgLabel c -> String -> Bool
forall c. CallArgLabel c -> String -> Bool
`matchesCallArgLabel` String
n = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> m ()
forall (m :: * -> *). ErrorContextM m => String -> m ()
compilerWarningM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                         [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                         String
" has a different name than arg label " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CallArgLabel c -> String
forall a. Show a => a -> String
show CallArgLabel c
l
    checkName Maybe (CallArgLabel c)
_ InputValue a
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    update :: Map VariableName (VariableValue c)
-> ((PassedValue c, Maybe (CallArgLabel c)), InputValue c)
-> m (Map VariableName (VariableValue c))
update Map VariableName (VariableValue c)
va ((PassedValue [c]
_ ValueType
t,Maybe (CallArgLabel c)
n),InputValue c
a) = do
      let c :: [c]
c = InputValue c -> [c]
forall c. InputValue c -> [c]
ivContext InputValue c
a
      case InputValue c -> VariableName
forall c. InputValue c -> VariableName
ivName InputValue c
a VariableName
-> Map VariableName (VariableValue c) -> Maybe (VariableValue c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName (VariableValue c)
va of
            Maybe (VariableValue c)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            (Just VariableValue c
v) -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (InputValue c -> VariableName
forall c. InputValue c -> VariableName
ivName InputValue c
a) 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]
++
                                         [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (VariableValue c -> [c]
forall c. VariableValue c -> [c]
vvContext VariableValue c
v)
      Maybe (CallArgLabel c) -> InputValue c -> m ()
forall {m :: * -> *} {a} {c}.
(ErrorContextM m, Show a, Show c) =>
Maybe (CallArgLabel c) -> InputValue a -> m ()
checkName Maybe (CallArgLabel c)
n InputValue c
a
      Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map VariableName (VariableValue c)
 -> m (Map VariableName (VariableValue c)))
-> Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall a b. (a -> b) -> a -> b
$ VariableName
-> VariableValue c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (InputValue c -> VariableName
forall c. InputValue c -> VariableName
ivName InputValue c
a) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c SymbolScope
LocalScope ValueType
t ([c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableReadOnly [c]
c)) Map VariableName (VariableValue c)
va