{- -----------------------------------------------------------------------------
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 {
    forall c. ScopeContext c -> CategoryMap c
scCategories :: CategoryMap c,
    forall c. ScopeContext c -> CategoryName
scName :: CategoryName,
    forall c. ScopeContext c -> Positional (ValueParam c)
scParams :: Positional (ValueParam c),
    forall c. ScopeContext c -> [DefinedMember c]
scValueMembers :: [DefinedMember c],
    forall c. ScopeContext c -> [ParamFilter c]
scFilters :: [ParamFilter c],
    forall c. ScopeContext c -> Map FunctionName (ScopedFunction c)
scFunctions :: Map.Map FunctionName (ScopedFunction c),
    forall c. ScopeContext c -> Map VariableName (VariableValue c)
scVariables :: Map.Map VariableName (VariableValue c),
    forall c. ScopeContext c -> ExprMap c
scExprMap :: ExprMap c
  }

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

applyProcedureScope ::
  (ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> a) -> ProcedureScope c -> [a]
applyProcedureScope :: forall c a.
(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) = forall a b. (a -> b) -> [a] -> [b]
map (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 :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
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 forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a -> m a
??> do
  ([c]
_,AnyCategory c
t) <- 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 = forall a. [a] -> Positional a
Positional forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ValueParam c]
getCategoryParams AnyCategory c
t
  let typeInstance :: TypeInstance
typeInstance = CategoryName -> InstanceParams -> TypeInstance
TypeInstance CategoryName
n forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (Eq a, Ord a) => a -> GeneralType a
singleType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ValueParam c -> ParamName
vpParam) Positional (ValueParam c)
params
  let rawFilters :: [ParamFilter c]
rawFilters = forall c. AnyCategory c -> [ParamFilter c]
getCategoryFilters AnyCategory c
t
  ParamFilters
filters <- forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  let r :: CategoryResolver c
r = forall c. CategoryMap c -> CategoryResolver c
CategoryResolver CategoryMap c
ta
  Map FunctionName (ScopedFunction c)
fa <- 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 <- 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) = forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope (forall c. ScopedFunction c -> SymbolScope
sfScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ScopedFunction c, ExecutableProcedure c)]
pa
  [(ScopedFunction c, ExecutableProcedure c)]
tp' <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall {m :: * -> *} {t} {a} {b}.
Monad m =>
(t -> m a) -> (t, b) -> m (a, b)
firstM forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> ScopedFunction c -> m (ScopedFunction c)
replaceSelfFunction (forall c. AnyCategory c -> GeneralInstance
instanceFromCategory AnyCategory c
t)) [(ScopedFunction c, ExecutableProcedure c)]
tp
  [(ScopedFunction c, ExecutableProcedure c)]
vp' <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall {m :: * -> *} {t} {a} {b}.
Monad m =>
(t -> m a) -> (t, b) -> m (a, b)
firstM forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> ScopedFunction c -> m (ScopedFunction c)
replaceSelfFunction (forall c. AnyCategory c -> GeneralInstance
instanceFromCategory AnyCategory c
t)) [(ScopedFunction c, ExecutableProcedure c)]
vp
  let ([DefinedMember c]
cm,[DefinedMember c]
tm,[DefinedMember c]
vm) = forall a. (a -> SymbolScope) -> [a] -> ([a], [a], [a])
partitionByScope forall c. DefinedMember c -> SymbolScope
dmScope [DefinedMember c]
ms
  [DefinedMember c]
tm' <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember (forall c. AnyCategory c -> GeneralInstance
instanceFromCategory AnyCategory c
t)) [DefinedMember c]
tm
  [DefinedMember c]
vm' <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember (forall c. AnyCategory c -> GeneralInstance
instanceFromCategory AnyCategory c
t)) [DefinedMember c]
vm
  let cm0 :: Map VariableName (VariableValue c)
cm0 = forall {c}.
TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
builtins TypeInstance
typeInstance SymbolScope
CategoryScope
  let tm0 :: Map VariableName (VariableValue c)
tm0 = forall {c}.
TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
builtins TypeInstance
typeInstance SymbolScope
TypeScope
  let vm0 :: Map VariableName (VariableValue c)
vm0 = forall {c}.
TypeInstance -> SymbolScope -> Map VariableName (VariableValue c)
builtins TypeInstance
typeInstance SymbolScope
ValueScope
  let immutable :: [c]
immutable = forall {c}. AnyCategory c -> [c]
immutableContext AnyCategory c
t
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
immutable) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
immutable
                     then Map VariableName [c]
readOnly
                     else forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map VariableName [c]
readOnly forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [VariableName]
valueMembers (forall a. a -> [a]
repeat [c]
immutable)
  let readOnly3 :: Map VariableName [c]
readOnly3 = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map VariableName [c]
inferredReadOnly Map VariableName [c]
readOnly2
  Map VariableName (VariableValue c)
cm2 <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly3 Map VariableName [c]
hidden [DefinedMember c]
cm
  Map VariableName (VariableValue c)
tm2 <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly3 Map VariableName [c]
hidden forall a b. (a -> b) -> a -> b
$ [DefinedMember c]
cm forall a. [a] -> [a] -> [a]
++ [DefinedMember c]
tm'
  Map VariableName (VariableValue c)
vm2 <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly3 Map VariableName [c]
hidden forall a b. (a -> b) -> a -> b
$ [DefinedMember c]
cm forall a. [a] -> [a] -> [a]
++ [DefinedMember c]
tm' forall a. [a] -> [a] -> [a]
++ [DefinedMember c]
vm'
  forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall {m :: * -> *} {a}.
(CollectErrorsM m, Show a) =>
PragmaDefined a -> m ()
checkPragma [PragmaDefined c]
pragmas
  m ()
warnDuplicateReadOnly
  let cv :: Map VariableName (VariableValue c)
cv = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall {c}. Map VariableName (VariableValue c)
cm0 Map VariableName (VariableValue c)
cm2
  let tv :: Map VariableName (VariableValue c)
tv = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall {c}. Map VariableName (VariableValue c)
tm0 Map VariableName (VariableValue c)
tm2
  let vv :: Map VariableName (VariableValue c)
vv = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall {c}. Map VariableName (VariableValue c)
vm0 Map VariableName (VariableValue c)
vm2
  let ctxC :: ScopeContext c
ctxC = 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 = 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 = 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
  forall (m :: * -> *) a. Monad m => a -> m a
return [forall c.
ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
ProcedureScope ScopeContext c
ctxC [(ScopedFunction c, ExecutableProcedure c)]
cp,forall c.
ScopeContext c
-> [(ScopedFunction c, ExecutableProcedure c)] -> ProcedureScope c
ProcedureScope ScopeContext c
ctxT [(ScopedFunction c, ExecutableProcedure c)]
tp',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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CategoryName
n forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> [Char]
formatFullContextBrace [c]
c
    warnDuplicateReadOnly :: m ()
warnDuplicateReadOnly = do
      let ro :: [PragmaDefined c]
ro  = forall a. (a -> Bool) -> [a] -> [a]
filter forall c. PragmaDefined c -> Bool
isMembersReadOnly       [PragmaDefined c]
pragmas
      let roe :: [PragmaDefined c]
roe = forall a. (a -> Bool) -> [a] -> [a]
filter forall c. PragmaDefined c -> Bool
isMembersReadOnlyExcept [PragmaDefined c]
pragmas
      case ([PragmaDefined c]
roe,[PragmaDefined c]
roeforall a. [a] -> [a] -> [a]
++[PragmaDefined c]
ro) of
           ([],[PragmaDefined c]
_)    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
           ([PragmaDefined c
_],[PragmaDefined c
_]) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
           ([PragmaDefined c]
_,[PragmaDefined c]
ra) -> [Char]
"ReadOnlyExcept should not be used with other read-only pragmas" forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a -> m a
??>
             forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
PragmaDefined a -> m ()
warnROPragma [PragmaDefined c]
ra
    warnROPragma :: PragmaDefined a -> m ()
warnROPragma (MembersReadOnly       [a]
c2 [VariableName]
_) = forall (m :: * -> *). ErrorContextM m => [Char] -> m ()
compilerWarningM forall a b. (a -> b) -> a -> b
$ [Char]
"ReadOnly at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> [Char]
formatFullContext [a]
c2
    warnROPragma (MembersReadOnlyExcept [a]
c2 [VariableName]
_) = forall (m :: * -> *). ErrorContextM m => [Char] -> m ()
compilerWarningM forall a b. (a -> b) -> a -> b
$ [Char]
"ReadOnlyExcept at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> [Char]
formatFullContext [a]
c2
    warnROPragma PragmaDefined a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    checkPragma :: PragmaDefined a -> m ()
checkPragma (MembersReadOnly [a]
c2 [VariableName]
vs) = do
      let missing :: [VariableName]
missing = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [VariableName]
vs forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set VariableName
allMembers
      forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\VariableName
v -> forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ [Char]
"Member " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show VariableName
v forall a. [a] -> [a] -> [a]
++
                                            [Char]
" does not exist (marked ReadOnly at " forall a. [a] -> [a] -> [a]
++
                                            forall a. Show a => [a] -> [Char]
formatFullContext [a]
c2 forall a. [a] -> [a] -> [a]
++ [Char]
")") [VariableName]
missing
    checkPragma (MembersReadOnlyExcept [a]
c2 [VariableName]
vs) = do
      let missing :: [VariableName]
missing = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [VariableName]
vs forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set VariableName
allMembers
      forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\VariableName
v -> forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ [Char]
"Member " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show VariableName
v forall a. [a] -> [a] -> [a]
++
                                            [Char]
" does not exist (marked ReadOnlyExcept at " forall a. [a] -> [a] -> [a]
++
                                            forall a. Show a => [a] -> [Char]
formatFullContext [a]
c2 forall a. [a] -> [a] -> [a]
++ [Char]
")") [VariableName]
missing
    checkPragma (MembersHidden [a]
c2 [VariableName]
vs) = do
      let missing :: [VariableName]
missing = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [VariableName]
vs forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set VariableName
allMembers
      forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (\VariableName
v -> forall (m :: * -> *) a. ErrorContextM m => [Char] -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ [Char]
"Member " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show VariableName
v forall a. [a] -> [a] -> [a]
++
                                            [Char]
" does not exist (marked Hidden at " forall a. [a] -> [a] -> [a]
++
                                            forall a. Show a => [a] -> [Char]
formatFullContext [a]
c2 forall a. [a] -> [a] -> [a]
++ [Char]
")") [VariableName]
missing
    checkPragma PragmaDefined a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    allMembers :: Set VariableName
allMembers = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. DefinedMember c -> VariableName
dmName [DefinedMember c]
ms
    valueMembers :: [VariableName]
valueMembers = forall a b. (a -> b) -> [a] -> [b]
map forall c. DefinedMember c -> VariableName
dmName forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> SymbolScope
dmScope) [DefinedMember c]
ms
    immutableContext :: AnyCategory c -> [c]
immutableContext AnyCategory c
t = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map forall c. PragmaCategory c -> [c]
ciContext forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall c. PragmaCategory c -> Bool
isCategoryImmutable (forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas AnyCategory c
t)) forall a. [a] -> [a] -> [a]
++ [[]]
    readOnlyExcept :: Maybe ([c], Set VariableName)
readOnlyExcept = case forall a. (a -> Bool) -> [a] -> [a]
filter forall c. PragmaDefined c -> Bool
isMembersReadOnlyExcept [PragmaDefined c]
pragmas of
                          [] -> forall a. Maybe a
Nothing
                          [PragmaDefined c]
ps2 -> forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. PragmaDefined c -> [c]
mroeContext [PragmaDefined c]
ps2,forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. PragmaDefined c -> [VariableName]
mroeMembers [PragmaDefined c]
ps2)
    inferredReadOnly :: Map VariableName [c]
inferredReadOnly = case Maybe ([c], Set VariableName)
readOnlyExcept of
                            Maybe ([c], Set VariableName)
Nothing -> forall k a. Map k a
Map.empty
                            Just ([c]
c2,Set VariableName
exempt) -> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat [c]
c2) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set VariableName
exempt)) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. DefinedMember c -> VariableName
dmName [DefinedMember c]
ms
    readOnly :: Map VariableName [c]
readOnly = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\PragmaDefined c
m -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall c. PragmaDefined c -> [VariableName]
mroMembers PragmaDefined c
m) (forall a. a -> [a]
repeat forall a b. (a -> b) -> a -> b
$ forall c. PragmaDefined c -> [c]
mroContext PragmaDefined c
m)) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall c. PragmaDefined c -> Bool
isMembersReadOnly [PragmaDefined c]
pragmas
    hidden :: Map VariableName [c]
hidden   = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\PragmaDefined c
m -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall c. PragmaDefined c -> [VariableName]
mhMembers PragmaDefined c
m)  (forall a. a -> [a]
repeat forall a b. (a -> b) -> a -> b
$ forall c. PragmaDefined c -> [c]
mhContext PragmaDefined c
m))  forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter 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
      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 = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((forall a. Ord a => a -> a -> Bool
<= SymbolScope
s0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. VariableValue c -> SymbolScope
vvScope) forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> m ()
checkValueTypeImmutable r
r ParamFilters
fs2 (forall c. DefinedMember c -> ValueType
dmType DefinedMember a
m) forall (m :: * -> *) a. ErrorContextM m => m a -> [Char] -> m a
<!!
      [Char]
"@value member " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall c. DefinedMember c -> VariableName
dmName DefinedMember a
m) forall a. [a] -> [a] -> [a]
++
      [Char]
" at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> [Char]
formatFullContext (forall c. DefinedMember c -> [c]
dmContext DefinedMember a
m) forall a. [a] -> [a] -> [a]
++
      [Char]
" must have an immutable type" forall a. [a] -> [a] -> [a]
++ 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 :: forall c. TypeInstance -> Map VariableName (VariableValue c)
builtinVariables TypeInstance
t = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
    (VariableName
VariableSelf,forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [] SymbolScope
ValueScope (StorageType -> GeneralInstance -> ValueType
ValueType StorageType
RequiredValue forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Ord a) => a -> GeneralType a
singleType forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance TypeInstance
t) (forall c. [c] -> VariableRule c
VariableReadOnly []))
  ]