{- -----------------------------------------------------------------------------
Copyright 2020-2021 Kevin P. Barry

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

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

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

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

{-# LANGUAGE Safe #-}

module Compilation.ScopeContext (
  ProcedureScope(..),
  ScopeContext(..),
  applyProcedureScope,
  builtinVariables,
  getProcedureScopes,
) where

import Control.Monad (when)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.GeneralType
import Base.Positional
import Compilation.ProcedureContext
import Types.DefinedCategory
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


data ScopeContext c =
  ScopeContext {
    ScopeContext c -> CategoryMap c
scCategories :: CategoryMap c,
    ScopeContext c -> CategoryName
scName :: CategoryName,
    ScopeContext c -> Positional (ValueParam c)
scParams :: Positional (ValueParam c),
    ScopeContext c -> [DefinedMember c]
scValueMembers :: [DefinedMember c],
    ScopeContext c -> [ParamFilter c]
scFilters :: [ParamFilter c],
    ScopeContext c -> Map FunctionName (ScopedFunction c)
scFunctions :: Map.Map FunctionName (ScopedFunction c),
    ScopeContext c -> Map VariableName (VariableValue c)
scVariables :: Map.Map VariableName (VariableValue c),
    ScopeContext c -> ExprMap c
scExprMap :: ExprMap c
  }

data ProcedureScope c =
  ProcedureScope {
    ProcedureScope c -> ScopeContext c
psContext :: ScopeContext c,
    ProcedureScope c -> [(ScopedFunction c, ExecutableProcedure c)]
psProcedures :: [(ScopedFunction c,ExecutableProcedure c)]
  }

applyProcedureScope ::
  (ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a) -> ProcedureScope c -> [a]
applyProcedureScope :: (ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a)
-> ProcedureScope c -> [a]
applyProcedureScope ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a
f (ProcedureScope ScopeContext c
ctx [(ScopedFunction c, ExecutableProcedure c)]
fs) = ((ScopedFunction c, ExecutableProcedure c) -> a)
-> [(ScopedFunction c, ExecutableProcedure c)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((ScopedFunction c -> ExecutableProcedure c -> a)
-> (ScopedFunction c, ExecutableProcedure c) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a
f ScopeContext c
ctx)) [(ScopedFunction c, ExecutableProcedure c)]
fs

getProcedureScopes :: (Ord c, Show c, CollectErrorsM m) =>
  CategoryMap c -> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
getProcedureScopes :: CategoryMap c
-> ExprMap c -> DefinedCategory c -> m [ProcedureScope c]
getProcedureScopes CategoryMap c
ta ExprMap c
em (DefinedCategory [c]
c CategoryName
n [PragmaDefined c]
pragmas [ValueRefine c]
_ [ValueDefine c]
_ [DefinedMember c]
ms [ExecutableProcedure c]
ps [ScopedFunction c]
fs) = [Char]
message [Char] -> m [ProcedureScope c] -> m [ProcedureScope c]
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a -> m a
??> do
  ([c]
_,AnyCategory c
t) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
ta ([c]
c,CategoryName
n)
  let params :: Positional (ValueParam c)
params = [ValueParam c] -> Positional (ValueParam c)
forall a. [a] -> Positional a
Positional ([ValueParam c] -> Positional (ValueParam c))
-> [ValueParam c] -> Positional (ValueParam c)
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ValueParam c]
forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
  let typeInstance :: TypeInstance
typeInstance = CategoryName -> InstanceParams -> TypeInstance
TypeInstance CategoryName
n (InstanceParams -> TypeInstance) -> InstanceParams -> TypeInstance
forall a b. (a -> b) -> a -> b
$ (ValueParam c -> GeneralType TypeInstanceOrParam)
-> Positional (ValueParam c) -> InstanceParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeInstanceOrParam -> GeneralType TypeInstanceOrParam
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralType TypeInstanceOrParam)
-> (ValueParam c -> TypeInstanceOrParam)
-> ValueParam c
-> GeneralType TypeInstanceOrParam
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)
params
  let rawFilters :: [ParamFilter c]
rawFilters = AnyCategory c -> [ParamFilter c]
forall c. AnyCategory c -> [ParamFilter c]
getCategoryFilters AnyCategory c
t
  ParamFilters
filters <- AnyCategory c -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  let r :: CategoryResolver c
r = CategoryMap c -> CategoryResolver c
forall c. CategoryMap c -> CategoryResolver c
CategoryResolver CategoryMap c
ta
  Map FunctionName (ScopedFunction c)
fa <- CategoryResolver c
-> AnyCategory c
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r
-> AnyCategory c
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
setInternalFunctions CategoryResolver c
r AnyCategory c
t [ScopedFunction c]
fs
  [(ScopedFunction c, ExecutableProcedure c)]
pa <- Map FunctionName (ScopedFunction c)
-> [ExecutableProcedure c]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map FunctionName (ScopedFunction c)
-> [ExecutableProcedure c]
-> m [(ScopedFunction c, ExecutableProcedure c)]
pairProceduresToFunctions Map FunctionName (ScopedFunction c)
fa [ExecutableProcedure c]
ps
  let ([(ScopedFunction c, ExecutableProcedure c)]
cp,[(ScopedFunction c, ExecutableProcedure c)]
tp,[(ScopedFunction c, ExecutableProcedure c)]
vp) = ((ScopedFunction c, ExecutableProcedure c) -> SymbolScope)
-> [(ScopedFunction c, ExecutableProcedure c)]
-> ([(ScopedFunction c, ExecutableProcedure c)],
    [(ScopedFunction c, ExecutableProcedure c)],
    [(ScopedFunction c, ExecutableProcedure c)])
forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope (ScopedFunction c -> SymbolScope)
-> ((ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c)
-> (ScopedFunction c, ExecutableProcedure c)
-> SymbolScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c, ExecutableProcedure c) -> ScopedFunction c
forall a b. (a, b) -> a
fst) [(ScopedFunction c, ExecutableProcedure c)]
pa
  [(ScopedFunction c, ExecutableProcedure c)]
tp' <- ((ScopedFunction c, ExecutableProcedure c)
 -> m (ScopedFunction c, ExecutableProcedure c))
-> [(ScopedFunction c, ExecutableProcedure c)]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ((ScopedFunction c -> m (ScopedFunction c))
-> (ScopedFunction c, ExecutableProcedure c)
-> m (ScopedFunction c, ExecutableProcedure c)
forall (m :: * -> *) t a b.
Monad m =>
(t -> m a) -> (t, b) -> m (a, b)
firstM ((ScopedFunction c -> m (ScopedFunction c))
 -> (ScopedFunction c, ExecutableProcedure c)
 -> m (ScopedFunction c, ExecutableProcedure c))
-> (ScopedFunction c -> m (ScopedFunction c))
-> (ScopedFunction c, ExecutableProcedure c)
-> m (ScopedFunction c, ExecutableProcedure c)
forall a b. (a -> b) -> a -> b
$ GeneralType TypeInstanceOrParam
-> ScopedFunction c -> m (ScopedFunction c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralType TypeInstanceOrParam
-> ScopedFunction c -> m (ScopedFunction c)
replaceSelfFunction (AnyCategory c -> GeneralType TypeInstanceOrParam
forall c. AnyCategory c -> GeneralType TypeInstanceOrParam
instanceFromCategory AnyCategory c
t)) [(ScopedFunction c, ExecutableProcedure c)]
tp
  [(ScopedFunction c, ExecutableProcedure c)]
vp' <- ((ScopedFunction c, ExecutableProcedure c)
 -> m (ScopedFunction c, ExecutableProcedure c))
-> [(ScopedFunction c, ExecutableProcedure c)]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ((ScopedFunction c -> m (ScopedFunction c))
-> (ScopedFunction c, ExecutableProcedure c)
-> m (ScopedFunction c, ExecutableProcedure c)
forall (m :: * -> *) t a b.
Monad m =>
(t -> m a) -> (t, b) -> m (a, b)
firstM ((ScopedFunction c -> m (ScopedFunction c))
 -> (ScopedFunction c, ExecutableProcedure c)
 -> m (ScopedFunction c, ExecutableProcedure c))
-> (ScopedFunction c -> m (ScopedFunction c))
-> (ScopedFunction c, ExecutableProcedure c)
-> m (ScopedFunction c, ExecutableProcedure c)
forall a b. (a -> b) -> a -> b
$ GeneralType TypeInstanceOrParam
-> ScopedFunction c -> m (ScopedFunction c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralType TypeInstanceOrParam
-> ScopedFunction c -> m (ScopedFunction c)
replaceSelfFunction (AnyCategory c -> GeneralType TypeInstanceOrParam
forall c. AnyCategory c -> GeneralType TypeInstanceOrParam
instanceFromCategory AnyCategory c
t)) [(ScopedFunction c, ExecutableProcedure c)]
vp
  let ([DefinedMember c]
cm,[DefinedMember c]
tm,[DefinedMember c]
vm) = (DefinedMember c -> SymbolScope)
-> [DefinedMember c]
-> ([DefinedMember c], [DefinedMember c], [DefinedMember c])
forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope [DefinedMember c]
ms
  [DefinedMember c]
tm' <- (DefinedMember c -> m (DefinedMember c))
-> [DefinedMember c] -> m [DefinedMember c]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (GeneralType TypeInstanceOrParam
-> DefinedMember c -> m (DefinedMember c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralType TypeInstanceOrParam
-> DefinedMember c -> m (DefinedMember c)
replaceSelfMember (AnyCategory c -> GeneralType TypeInstanceOrParam
forall c. AnyCategory c -> GeneralType TypeInstanceOrParam
instanceFromCategory AnyCategory c
t)) [DefinedMember c]
tm
  [DefinedMember c]
vm' <- (DefinedMember c -> m (DefinedMember c))
-> [DefinedMember c] -> m [DefinedMember c]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (GeneralType TypeInstanceOrParam
-> DefinedMember c -> m (DefinedMember c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralType TypeInstanceOrParam
-> DefinedMember c -> m (DefinedMember c)
replaceSelfMember (AnyCategory c -> GeneralType TypeInstanceOrParam
forall c. AnyCategory c -> GeneralType TypeInstanceOrParam
instanceFromCategory AnyCategory c
t)) [DefinedMember c]
vm
  let cm0 :: Map VariableName (VariableValue c)
cm0 = TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
forall c.
TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
builtins TypeInstance
typeInstance SymbolScope
CategoryScope
  let tm0 :: Map VariableName (VariableValue c)
tm0 = TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
forall c.
TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
builtins TypeInstance
typeInstance SymbolScope
TypeScope
  let vm0 :: Map VariableName (VariableValue c)
vm0 = TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
forall c.
TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
builtins TypeInstance
typeInstance SymbolScope
ValueScope
  let immutable :: [c]
immutable = AnyCategory c -> [c]
forall c. AnyCategory c -> [c]
immutableContext AnyCategory c
t
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [c] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
immutable) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> m ()) -> [DefinedMember c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (CategoryResolver c
-> ParamFilters -> [c] -> DefinedMember c -> m ()
forall (m :: * -> *) r a a.
(CollectErrorsM m, TypeResolver r, Show a, Show a) =>
r -> ParamFilters -> [a] -> DefinedMember a -> m ()
checkImmutableMember CategoryResolver c
r ParamFilters
filters [c]
immutable) [DefinedMember c]
vm'
  let readOnly2 :: Map VariableName [c]
readOnly2 = if [c] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
immutable
                     then Map VariableName [c]
readOnly
                     else ([c] -> [c] -> [c])
-> [(VariableName, [c])] -> Map VariableName [c]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) ([(VariableName, [c])] -> Map VariableName [c])
-> [(VariableName, [c])] -> Map VariableName [c]
forall a b. (a -> b) -> a -> b
$ Map VariableName [c] -> [(VariableName, [c])]
forall k a. Map k a -> [(k, a)]
Map.toList Map VariableName [c]
readOnly [(VariableName, [c])]
-> [(VariableName, [c])] -> [(VariableName, [c])]
forall a. [a] -> [a] -> [a]
++ [VariableName] -> [[c]] -> [(VariableName, [c])]
forall a b. [a] -> [b] -> [(a, b)]
zip [VariableName]
valueMembers ([c] -> [[c]]
forall a. a -> [a]
repeat [c]
immutable)
  Map VariableName (VariableValue c)
cm2 <- Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly2 Map VariableName [c]
hidden [DefinedMember c]
cm
  Map VariableName (VariableValue c)
tm2 <- Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly2 Map VariableName [c]
hidden ([DefinedMember c] -> m (Map VariableName (VariableValue c)))
-> [DefinedMember c] -> m (Map VariableName (VariableValue c))
forall a b. (a -> b) -> a -> b
$ [DefinedMember c]
cm [DefinedMember c] -> [DefinedMember c] -> [DefinedMember c]
forall a. [a] -> [a] -> [a]
++ [DefinedMember c]
tm'
  Map VariableName (VariableValue c)
vm2 <- Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly2 Map VariableName [c]
hidden ([DefinedMember c] -> m (Map VariableName (VariableValue c)))
-> [DefinedMember c] -> m (Map VariableName (VariableValue c))
forall a b. (a -> b) -> a -> b
$ [DefinedMember c]
cm [DefinedMember c] -> [DefinedMember c] -> [DefinedMember c]
forall a. [a] -> [a] -> [a]
++ [DefinedMember c]
tm' [DefinedMember c] -> [DefinedMember c] -> [DefinedMember c]
forall a. [a] -> [a] -> [a]
++ [DefinedMember c]
vm'
  (PragmaDefined c -> m ()) -> [PragmaDefined c] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ PragmaDefined c -> m ()
forall (m :: * -> *) a.
(CollectErrorsM m, Show a) =>
PragmaDefined a -> m ()
checkPragma [PragmaDefined c]
pragmas
  let cv :: Map VariableName (VariableValue c)
cv = Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map VariableName (VariableValue c)
forall c. Map VariableName (VariableValue c)
cm0 Map VariableName (VariableValue c)
cm2
  let tv :: Map VariableName (VariableValue c)
tv = Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map VariableName (VariableValue c)
forall c. Map VariableName (VariableValue c)
tm0 Map VariableName (VariableValue c)
tm2
  let vv :: Map VariableName (VariableValue c)
vv = Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map VariableName (VariableValue c)
forall c. Map VariableName (VariableValue c)
vm0 Map VariableName (VariableValue c)
vm2
  let ctxC :: ScopeContext c
ctxC = CategoryMap c
-> CategoryName
-> Positional (ValueParam c)
-> [DefinedMember c]
-> [ParamFilter c]
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ExprMap c
-> ScopeContext c
forall c.
CategoryMap c
-> CategoryName
-> Positional (ValueParam c)
-> [DefinedMember c]
-> [ParamFilter c]
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ExprMap c
-> ScopeContext c
ScopeContext CategoryMap c
ta CategoryName
n Positional (ValueParam c)
params [DefinedMember c]
vm' [ParamFilter c]
rawFilters Map FunctionName (ScopedFunction c)
fa Map VariableName (VariableValue c)
cv ExprMap c
em
  let ctxT :: ScopeContext c
ctxT = CategoryMap c
-> CategoryName
-> Positional (ValueParam c)
-> [DefinedMember c]
-> [ParamFilter c]
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ExprMap c
-> ScopeContext c
forall c.
CategoryMap c
-> CategoryName
-> Positional (ValueParam c)
-> [DefinedMember c]
-> [ParamFilter c]
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ExprMap c
-> ScopeContext c
ScopeContext CategoryMap c
ta CategoryName
n Positional (ValueParam c)
params [DefinedMember c]
vm' [ParamFilter c]
rawFilters Map FunctionName (ScopedFunction c)
fa Map VariableName (VariableValue c)
tv ExprMap c
em
  let ctxV :: ScopeContext c
ctxV = CategoryMap c
-> CategoryName
-> Positional (ValueParam c)
-> [DefinedMember c]
-> [ParamFilter c]
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ExprMap c
-> ScopeContext c
forall c.
CategoryMap c
-> CategoryName
-> Positional (ValueParam c)
-> [DefinedMember c]
-> [ParamFilter c]
-> Map FunctionName (ScopedFunction c)
-> Map VariableName (VariableValue c)
-> ExprMap c
-> ScopeContext c
ScopeContext CategoryMap c
ta CategoryName
n Positional (ValueParam c)
params [DefinedMember c]
vm' [ParamFilter c]
rawFilters Map FunctionName (ScopedFunction c)
fa Map VariableName (VariableValue c)
vv ExprMap c
em
  [ProcedureScope c] -> m [ProcedureScope c]
forall (m :: * -> *) a. Monad m => a -> m a
return [ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
forall c.
ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
ProcedureScope ScopeContext c
ctxC [(ScopedFunction c, ExecutableProcedure c)]
cp,ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
forall c.
ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
ProcedureScope ScopeContext c
ctxT [(ScopedFunction c, ExecutableProcedure c)]
tp',ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
forall c.
ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
ProcedureScope ScopeContext c
ctxV [(ScopedFunction c, ExecutableProcedure c)]
vp']
  where
    message :: [Char]
message = [Char]
"In compilation of definition for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CategoryName -> [Char]
forall a. Show a => a -> [Char]
show CategoryName
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [c] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace [c]
c
    checkPragma :: PragmaDefined a -> m ()
checkPragma (MembersReadOnly [a]
c2 [VariableName]
vs) = do
      let missing :: [VariableName]
missing = Set VariableName -> [VariableName]
forall a. Set a -> [a]
Set.toList (Set VariableName -> [VariableName])
-> Set VariableName -> [VariableName]
forall a b. (a -> b) -> a -> b
$ [VariableName] -> Set VariableName
forall a. Ord a => [a] -> Set a
Set.fromList [VariableName]
vs Set VariableName -> Set VariableName -> Set VariableName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set VariableName
allMembers
      (VariableName -> m Any) -> [VariableName] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\VariableName
v -> [Char] -> m Any
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char] -> m Any) -> [Char] -> m Any
forall a b. (a -> b) -> a -> b
$ [Char]
"Member " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ VariableName -> [Char]
forall a. Show a => a -> [Char]
show VariableName
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                            [Char]
" does not exist (marked ReadOnly at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                            [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContext [a]
c2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")") [VariableName]
missing
    checkPragma (MembersHidden [a]
c2 [VariableName]
vs) = do
      let missing :: [VariableName]
missing = Set VariableName -> [VariableName]
forall a. Set a -> [a]
Set.toList (Set VariableName -> [VariableName])
-> Set VariableName -> [VariableName]
forall a b. (a -> b) -> a -> b
$ [VariableName] -> Set VariableName
forall a. Ord a => [a] -> Set a
Set.fromList [VariableName]
vs Set VariableName -> Set VariableName -> Set VariableName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set VariableName
allMembers
      (VariableName -> m Any) -> [VariableName] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\VariableName
v -> [Char] -> m Any
forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM ([Char] -> m Any) -> [Char] -> m Any
forall a b. (a -> b) -> a -> b
$ [Char]
"Member " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ VariableName -> [Char]
forall a. Show a => a -> [Char]
show VariableName
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                            [Char]
" does not exist (marked Hidden at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                            [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContext [a]
c2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")") [VariableName]
missing
    allMembers :: Set VariableName
allMembers = [VariableName] -> Set VariableName
forall a. Ord a => [a] -> Set a
Set.fromList ([VariableName] -> Set VariableName)
-> [VariableName] -> Set VariableName
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> VariableName)
-> [DefinedMember c] -> [VariableName]
forall a b. (a -> b) -> [a] -> [b]
map DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName [DefinedMember c]
ms
    valueMembers :: [VariableName]
valueMembers = (DefinedMember c -> VariableName)
-> [DefinedMember c] -> [VariableName]
forall a b. (a -> b) -> [a] -> [b]
map DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName ([DefinedMember c] -> [VariableName])
-> [DefinedMember c] -> [VariableName]
forall a b. (a -> b) -> a -> b
$ (DefinedMember c -> Bool) -> [DefinedMember c] -> [DefinedMember c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) (SymbolScope -> Bool)
-> (DefinedMember c -> SymbolScope) -> DefinedMember c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope) [DefinedMember c]
ms
    immutableContext :: AnyCategory c -> [c]
immutableContext AnyCategory c
t = [[c]] -> [c]
forall a. [a] -> a
head ([[c]] -> [c]) -> [[c]] -> [c]
forall a b. (a -> b) -> a -> b
$ ((PragmaCategory c -> [c]) -> [PragmaCategory c] -> [[c]]
forall a b. (a -> b) -> [a] -> [b]
map PragmaCategory c -> [c]
forall c. PragmaCategory c -> [c]
ciContext ([PragmaCategory c] -> [[c]]) -> [PragmaCategory c] -> [[c]]
forall a b. (a -> b) -> a -> b
$ (PragmaCategory c -> Bool)
-> [PragmaCategory c] -> [PragmaCategory c]
forall a. (a -> Bool) -> [a] -> [a]
filter PragmaCategory c -> Bool
forall c. PragmaCategory c -> Bool
isCategoryImmutable (AnyCategory c -> [PragmaCategory c]
forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas AnyCategory c
t)) [[c]] -> [[c]] -> [[c]]
forall a. [a] -> [a] -> [a]
++ [[]]
    readOnly :: Map VariableName [c]
readOnly = ([c] -> [c] -> [c])
-> [(VariableName, [c])] -> Map VariableName [c]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) ([(VariableName, [c])] -> Map VariableName [c])
-> [(VariableName, [c])] -> Map VariableName [c]
forall a b. (a -> b) -> a -> b
$ [[(VariableName, [c])]] -> [(VariableName, [c])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(VariableName, [c])]] -> [(VariableName, [c])])
-> [[(VariableName, [c])]] -> [(VariableName, [c])]
forall a b. (a -> b) -> a -> b
$ (PragmaDefined c -> [(VariableName, [c])])
-> [PragmaDefined c] -> [[(VariableName, [c])]]
forall a b. (a -> b) -> [a] -> [b]
map (\PragmaDefined c
m -> [VariableName] -> [[c]] -> [(VariableName, [c])]
forall a b. [a] -> [b] -> [(a, b)]
zip (PragmaDefined c -> [VariableName]
forall c. PragmaDefined c -> [VariableName]
mroMembers PragmaDefined c
m) ([c] -> [[c]]
forall a. a -> [a]
repeat ([c] -> [[c]]) -> [c] -> [[c]]
forall a b. (a -> b) -> a -> b
$ PragmaDefined c -> [c]
forall c. PragmaDefined c -> [c]
mroContext PragmaDefined c
m)) ([PragmaDefined c] -> [[(VariableName, [c])]])
-> [PragmaDefined c] -> [[(VariableName, [c])]]
forall a b. (a -> b) -> a -> b
$ (PragmaDefined c -> Bool) -> [PragmaDefined c] -> [PragmaDefined c]
forall a. (a -> Bool) -> [a] -> [a]
filter PragmaDefined c -> Bool
forall c. PragmaDefined c -> Bool
isMembersReadOnly [PragmaDefined c]
pragmas
    hidden :: Map VariableName [c]
hidden   = ([c] -> [c] -> [c])
-> [(VariableName, [c])] -> Map VariableName [c]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
(++) ([(VariableName, [c])] -> Map VariableName [c])
-> [(VariableName, [c])] -> Map VariableName [c]
forall a b. (a -> b) -> a -> b
$ [[(VariableName, [c])]] -> [(VariableName, [c])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(VariableName, [c])]] -> [(VariableName, [c])])
-> [[(VariableName, [c])]] -> [(VariableName, [c])]
forall a b. (a -> b) -> a -> b
$ (PragmaDefined c -> [(VariableName, [c])])
-> [PragmaDefined c] -> [[(VariableName, [c])]]
forall a b. (a -> b) -> [a] -> [b]
map (\PragmaDefined c
m -> [VariableName] -> [[c]] -> [(VariableName, [c])]
forall a b. [a] -> [b] -> [(a, b)]
zip (PragmaDefined c -> [VariableName]
forall c. PragmaDefined c -> [VariableName]
mhMembers PragmaDefined c
m)  ([c] -> [[c]]
forall a. a -> [a]
repeat ([c] -> [[c]]) -> [c] -> [[c]]
forall a b. (a -> b) -> a -> b
$ PragmaDefined c -> [c]
forall c. PragmaDefined c -> [c]
mhContext PragmaDefined c
m))  ([PragmaDefined c] -> [[(VariableName, [c])]])
-> [PragmaDefined c] -> [[(VariableName, [c])]]
forall a b. (a -> b) -> a -> b
$ (PragmaDefined c -> Bool) -> [PragmaDefined c] -> [PragmaDefined c]
forall a. (a -> Bool) -> [a] -> [a]
filter PragmaDefined c -> Bool
forall c. PragmaDefined c -> Bool
isMembersHidden   [PragmaDefined c]
pragmas
    firstM :: (t -> m a) -> (t, b) -> m (a, b)
firstM t -> m a
f (t
x,b
y) = do
      a
x' <- t -> m a
f t
x
      (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x',b
y)
    builtins :: TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
builtins TypeInstance
t SymbolScope
s0 = (VariableValue c -> Bool)
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((SymbolScope -> SymbolScope -> Bool
forall a. Ord a => a -> a -> Bool
<= SymbolScope
s0) (SymbolScope -> Bool)
-> (VariableValue c -> SymbolScope) -> VariableValue c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VariableValue c -> SymbolScope
forall c. VariableValue c -> SymbolScope
vvScope) (Map VariableName (VariableValue c)
 -> Map VariableName (VariableValue c))
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall a b. (a -> b) -> a -> b
$ TypeInstance -> Map VariableName (VariableValue c)
forall c. TypeInstance -> Map VariableName (VariableValue c)
builtinVariables TypeInstance
t
    checkImmutableMember :: r -> ParamFilters -> [a] -> DefinedMember a -> m ()
checkImmutableMember r
r ParamFilters
fs2 [a]
c2 DefinedMember a
m = r -> ParamFilters -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> m ()
checkValueTypeImmutable r
r ParamFilters
fs2 (DefinedMember a -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember a
m) m () -> [Char] -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> [Char] -> m a
<!!
      [Char]
"@value member " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ VariableName -> [Char]
forall a. Show a => a -> [Char]
show (DefinedMember a -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember a
m) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
" at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContext (DefinedMember a -> [a]
forall c. DefinedMember c -> [c]
dmContext DefinedMember a
m) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
" must have an immutable type" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
formatFullContextBrace [a]
c2

-- TODO: This is probably in the wrong module.
builtinVariables :: TypeInstance -> Map.Map VariableName (VariableValue c)
builtinVariables :: TypeInstance -> Map VariableName (VariableValue c)
builtinVariables TypeInstance
t = [(VariableName, VariableValue c)]
-> Map VariableName (VariableValue c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
    (VariableName
VariableSelf,[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [] SymbolScope
ValueScope (StorageType -> GeneralType TypeInstanceOrParam -> ValueType
ValueType StorageType
RequiredValue (GeneralType TypeInstanceOrParam -> ValueType)
-> GeneralType TypeInstanceOrParam -> ValueType
forall a b. (a -> b) -> a -> b
$ TypeInstanceOrParam -> GeneralType TypeInstanceOrParam
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralType TypeInstanceOrParam)
-> TypeInstanceOrParam -> GeneralType TypeInstanceOrParam
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance TypeInstance
t) ([c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableReadOnly []))
  ]