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

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

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

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

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

{-# LANGUAGE Safe #-}

module Types.DefinedCategory (
  DefinedCategory(..),
  DefinedMember(..),
  PragmaDefined(..),
  VariableRule(..),
  VariableValue(..),
  isInitialized,
  isFlatCleanup,
  isMembersHidden,
  isMembersReadOnly,
  isMembersReadOnlyExcept,
  mapMembers,
  mergeInternalInheritance,
  pairProceduresToFunctions,
  replaceSelfMember,
  setInternalFunctions,
) where

import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.GeneralType
import Base.Positional
import Types.Function
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance
import Types.Variance


data DefinedCategory c =
  DefinedCategory {
    forall c. DefinedCategory c -> [c]
dcContext :: [c],
    forall c. DefinedCategory c -> CategoryName
dcName :: CategoryName,
    forall c. DefinedCategory c -> [PragmaDefined c]
dcPragmas :: [PragmaDefined c],
    forall c. DefinedCategory c -> [ValueRefine c]
dcRefines :: [ValueRefine c],
    forall c. DefinedCategory c -> [ValueDefine c]
dcDefines :: [ValueDefine c],
    forall c. DefinedCategory c -> [DefinedMember c]
dcMembers :: [DefinedMember c],
    forall c. DefinedCategory c -> [ExecutableProcedure c]
dcProcedures :: [ExecutableProcedure c],
    forall c. DefinedCategory c -> [ScopedFunction c]
dcFunctions :: [ScopedFunction c]
  }
  deriving (Int -> DefinedCategory c -> ShowS
forall c. Show c => Int -> DefinedCategory c -> ShowS
forall c. Show c => [DefinedCategory c] -> ShowS
forall c. Show c => DefinedCategory c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefinedCategory c] -> ShowS
$cshowList :: forall c. Show c => [DefinedCategory c] -> ShowS
show :: DefinedCategory c -> String
$cshow :: forall c. Show c => DefinedCategory c -> String
showsPrec :: Int -> DefinedCategory c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> DefinedCategory c -> ShowS
Show) -- TODO: Implement Show.

data DefinedMember c =
  DefinedMember {
    forall c. DefinedMember c -> [c]
dmContext :: [c],
    forall c. DefinedMember c -> SymbolScope
dmScope :: SymbolScope,
    forall c. DefinedMember c -> ValueType
dmType :: ValueType,
    forall c. DefinedMember c -> VariableName
dmName :: VariableName,
    forall c. DefinedMember c -> Maybe (Expression c)
dmInit :: Maybe (Expression c)
  }
  deriving (Int -> DefinedMember c -> ShowS
forall c. Show c => Int -> DefinedMember c -> ShowS
forall c. Show c => [DefinedMember c] -> ShowS
forall c. Show c => DefinedMember c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefinedMember c] -> ShowS
$cshowList :: forall c. Show c => [DefinedMember c] -> ShowS
show :: DefinedMember c -> String
$cshow :: forall c. Show c => DefinedMember c -> String
showsPrec :: Int -> DefinedMember c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> DefinedMember c -> ShowS
Show) -- TODO: Implement Show.

isInitialized :: DefinedMember c -> Bool
isInitialized :: forall c. DefinedMember c -> Bool
isInitialized = forall {a}. Maybe a -> Bool
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. DefinedMember c -> Maybe (Expression c)
dmInit where
  check :: Maybe a -> Bool
check Maybe a
Nothing = Bool
False
  check Maybe a
_       = Bool
True

data PragmaDefined c =
  MembersReadOnly {
    forall c. PragmaDefined c -> [c]
mroContext :: [c],
    forall c. PragmaDefined c -> [VariableName]
mroMembers :: [VariableName]
  } |
  MembersReadOnlyExcept {
    forall c. PragmaDefined c -> [c]
mroeContext :: [c],
    forall c. PragmaDefined c -> [VariableName]
mroeMembers :: [VariableName]
  } |
  MembersHidden {
    forall c. PragmaDefined c -> [c]
mhContext :: [c],
    forall c. PragmaDefined c -> [VariableName]
mhMembers :: [VariableName]
  } |
  FlatCleanup {
    forall c. PragmaDefined c -> [c]
fcContext :: [c],
    forall c. PragmaDefined c -> VariableName
fcMember :: VariableName
  }
  deriving (Int -> PragmaDefined c -> ShowS
forall c. Show c => Int -> PragmaDefined c -> ShowS
forall c. Show c => [PragmaDefined c] -> ShowS
forall c. Show c => PragmaDefined c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PragmaDefined c] -> ShowS
$cshowList :: forall c. Show c => [PragmaDefined c] -> ShowS
show :: PragmaDefined c -> String
$cshow :: forall c. Show c => PragmaDefined c -> String
showsPrec :: Int -> PragmaDefined c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> PragmaDefined c -> ShowS
Show)

isMembersReadOnly :: PragmaDefined c -> Bool
isMembersReadOnly :: forall c. PragmaDefined c -> Bool
isMembersReadOnly (MembersReadOnly [c]
_ [VariableName]
_) = Bool
True
isMembersReadOnly PragmaDefined c
_                     = Bool
False

isMembersReadOnlyExcept :: PragmaDefined c -> Bool
isMembersReadOnlyExcept :: forall c. PragmaDefined c -> Bool
isMembersReadOnlyExcept (MembersReadOnlyExcept [c]
_ [VariableName]
_) = Bool
True
isMembersReadOnlyExcept PragmaDefined c
_                           = Bool
False

isMembersHidden :: PragmaDefined c -> Bool
isMembersHidden :: forall c. PragmaDefined c -> Bool
isMembersHidden (MembersHidden [c]
_ [VariableName]
_) = Bool
True
isMembersHidden PragmaDefined c
_                   = Bool
False

isFlatCleanup :: PragmaDefined c -> Bool
isFlatCleanup :: forall c. PragmaDefined c -> Bool
isFlatCleanup (FlatCleanup [c]
_ VariableName
_) = Bool
True
isFlatCleanup PragmaDefined c
_                 = Bool
False

data VariableRule c =
  VariableDefault |
  VariableReadOnly {
    forall c. VariableRule c -> [c]
vroContext :: [c]
  } |
  VariableHidden {
    forall c. VariableRule c -> [c]
vhContext :: [c]
  }

data VariableValue c =
  VariableValue {
    forall c. VariableValue c -> [c]
vvContext :: [c],
    forall c. VariableValue c -> SymbolScope
vvScope :: SymbolScope,
    forall c. VariableValue c -> ValueType
vvType :: ValueType,
    forall c. VariableValue c -> VariableRule c
vvReadOnlyAt :: VariableRule c
  }

instance Show c => Show (VariableValue c) where
  show :: VariableValue c -> String
show (VariableValue [c]
c SymbolScope
_ ValueType
t VariableRule c
ro) = forall a. Show a => a -> String
show ValueType
t forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContextBrace [c]
c forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => VariableRule a -> String
format VariableRule c
ro where
    format :: VariableRule a -> String
format (VariableReadOnly [a]
c2) = String
" (read-only at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContext [a]
c2 forall a. [a] -> [a] -> [a]
++ String
")"
    format (VariableHidden [a]
c2)   = String
" (hidden at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContext [a]
c2 forall a. [a] -> [a] -> [a]
++ String
")"
    format VariableRule a
_ = String
""

setInternalFunctions :: (Show c, CollectErrorsM m, TypeResolver r) =>
  r -> AnyCategory c -> [ScopedFunction c] ->
  m (Map.Map FunctionName (ScopedFunction c))
setInternalFunctions :: forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r
-> AnyCategory c
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
setInternalFunctions r
r AnyCategory c
t [ScopedFunction c]
fs = do
  ParamFilters
fm <- forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {m :: * -> *}.
CollectErrorsM m =>
ParamFilters
-> ScopedFunction c
-> m (Map FunctionName (ScopedFunction c))
-> m (Map FunctionName (ScopedFunction c))
update ParamFilters
fm) (forall (m :: * -> *) a. Monad m => a -> m a
return Map FunctionName (ScopedFunction c)
start) [ScopedFunction c]
fs where
  start :: Map FunctionName (ScopedFunction c)
start = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,ScopedFunction c
f)) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
  pm :: ParamValues
pm = forall c. AnyCategory c -> ParamValues
getCategoryParamMap AnyCategory c
t
  update :: ParamFilters
-> ScopedFunction c
-> m (Map FunctionName (ScopedFunction c))
-> m (Map FunctionName (ScopedFunction c))
update ParamFilters
fm f :: ScopedFunction c
f@(ScopedFunction [c]
c FunctionName
n CategoryName
t2 SymbolScope
s FunctionVisibility c
v Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs2 [ScopedFunction c]
ms) m (Map FunctionName (ScopedFunction c))
fa = do
    forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r -> AnyCategory c -> ScopedFunction c -> m ()
validateCategoryFunction r
r AnyCategory c
t ScopedFunction c
f
    Map FunctionName (ScopedFunction c)
fa' <- m (Map FunctionName (ScopedFunction c))
fa
    case FunctionName
n forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ScopedFunction c)
fa' of
         Maybe (ScopedFunction c)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
n ScopedFunction c
f Map FunctionName (ScopedFunction c)
fa'
         (Just f0 :: ScopedFunction c
f0@(ScopedFunction [c]
c2 FunctionName
_ CategoryName
_ SymbolScope
_ FunctionVisibility c
_ Positional (PassedValue c, Maybe (CallArgLabel c))
_ Positional (PassedValue c)
_ Positional (ValueParam c)
_ [ParamFilter c]
_ [ScopedFunction c]
ms2)) -> do
           (String
"In function merge:\n---\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ScopedFunction c
f0 forall a. [a] -> [a] -> [a]
++
             String
"\n  ->\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ScopedFunction c
f forall a. [a] -> [a] -> [a]
++ String
"\n---\n") forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
              FunctionType
f0' <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f0
              FunctionType
f' <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f
              case SymbolScope
s of
                   SymbolScope
CategoryScope -> forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
checkFunctionConvert r
r forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty FunctionType
f0' FunctionType
f'
                   SymbolScope
_             -> forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
checkFunctionConvert r
r ParamFilters
fm ParamValues
pm FunctionType
f0' FunctionType
f'
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
n (forall c.
[c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> FunctionVisibility c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
ScopedFunction ([c]
cforall a. [a] -> [a] -> [a]
++[c]
c2) FunctionName
n CategoryName
t2 SymbolScope
s FunctionVisibility c
v Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs2 ([ScopedFunction c
f0]forall a. [a] -> [a] -> [a]
++[ScopedFunction c]
msforall a. [a] -> [a] -> [a]
++[ScopedFunction c]
ms2)) Map FunctionName (ScopedFunction c)
fa'

pairProceduresToFunctions :: (Show c, CollectErrorsM m) =>
  Map.Map FunctionName (ScopedFunction c) -> [ExecutableProcedure c] ->
  m [(ScopedFunction c,ExecutableProcedure c)]
pairProceduresToFunctions :: 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 = do
  Map FunctionName (ExecutableProcedure c)
pa <- forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {m :: * -> *} {c}.
(ErrorContextM m, Show c) =>
ExecutableProcedure c
-> m (Map FunctionName (ExecutableProcedure c))
-> m (Map FunctionName (ExecutableProcedure c))
updateProcedure (forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty) [ExecutableProcedure c]
ps
  let allNames :: Set FunctionName
allNames = forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall k a. Map k a -> Set k
Map.keysSet Map FunctionName (ScopedFunction c)
fa) (forall k a. Map k a -> Set k
Map.keysSet Map FunctionName (ExecutableProcedure c)
pa)
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {m :: * -> *} {a} {a} {k}.
(Show a, Show a, CollectErrorsM m, Ord k) =>
Map k (ScopedFunction a)
-> Map k (ExecutableProcedure a)
-> k
-> m [(ScopedFunction a, ExecutableProcedure a)]
-> m [(ScopedFunction a, ExecutableProcedure a)]
updatePairs Map FunctionName (ScopedFunction c)
fa Map FunctionName (ExecutableProcedure c)
pa) (forall (m :: * -> *) a. Monad m => a -> m a
return []) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set FunctionName
allNames
  where
    updateProcedure :: ExecutableProcedure c
-> m (Map FunctionName (ExecutableProcedure c))
-> m (Map FunctionName (ExecutableProcedure c))
updateProcedure ExecutableProcedure c
p m (Map FunctionName (ExecutableProcedure c))
pa = do
      Map FunctionName (ExecutableProcedure c)
pa' <- m (Map FunctionName (ExecutableProcedure c))
pa
      case forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ExecutableProcedure c)
pa' of
           Maybe (ExecutableProcedure c)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
           -- TODO: The error might show things in the wrong order.
           (Just ExecutableProcedure c
p0) -> forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Procedure " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p) forall a. [a] -> [a] -> [a]
++
                                       forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure c
p) forall a. [a] -> [a] -> [a]
++
                                       String
" is already defined" forall a. [a] -> [a] -> [a]
++
                                       forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure c
p0)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p) ExecutableProcedure c
p Map FunctionName (ExecutableProcedure c)
pa'
    updatePairs :: Map k (ScopedFunction a)
-> Map k (ExecutableProcedure a)
-> k
-> m [(ScopedFunction a, ExecutableProcedure a)]
-> m [(ScopedFunction a, ExecutableProcedure a)]
updatePairs Map k (ScopedFunction a)
fa2 Map k (ExecutableProcedure a)
pa k
n m [(ScopedFunction a, ExecutableProcedure a)]
ps2 = do
      [(ScopedFunction a, ExecutableProcedure a)]
ps2' <- m [(ScopedFunction a, ExecutableProcedure a)]
ps2
      (ScopedFunction a, ExecutableProcedure a)
p <- forall {m :: * -> *} {a} {a}.
(Show a, Show a, CollectErrorsM m) =>
Maybe (ScopedFunction a)
-> Maybe (ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
getPair (k
n forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (ScopedFunction a)
fa2) (k
n forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (ExecutableProcedure a)
pa)
      forall (m :: * -> *) a. Monad m => a -> m a
return ((ScopedFunction a, ExecutableProcedure a)
pforall a. a -> [a] -> [a]
:[(ScopedFunction a, ExecutableProcedure a)]
ps2')
    getPair :: Maybe (ScopedFunction a)
-> Maybe (ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
getPair (Just ScopedFunction a
f) Maybe (ExecutableProcedure a)
Nothing =
      forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Function " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) forall a. [a] -> [a] -> [a]
++
                     forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f) forall a. [a] -> [a] -> [a]
++
                     String
" has no procedure definition"
    getPair Maybe (ScopedFunction a)
Nothing (Just ExecutableProcedure a
p) =
      forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Procedure " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure a
p) forall a. [a] -> [a] -> [a]
++
                     forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure a
p) forall a. [a] -> [a] -> [a]
++
                     String
" does not correspond to a function"
    getPair (Just ScopedFunction a
f) (Just ExecutableProcedure a
p) = do
      forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c. PassedValue c -> ValueType
pvType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction a
f) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. InputValue c -> VariableName
inputValueName forall a b. (a -> b) -> a -> b
$ forall c. ArgValues c -> Positional (InputValue c)
avNames forall a b. (a -> b) -> a -> b
$ forall c. ExecutableProcedure c -> ArgValues c
epArgs ExecutableProcedure a
p) forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
        (String
"Procedure for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) forall a. [a] -> [a] -> [a]
++
         forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ArgValues c -> [c]
avContext forall a b. (a -> b) -> a -> b
$ forall c. ExecutableProcedure c -> ArgValues c
epArgs ExecutableProcedure a
p) forall a. [a] -> [a] -> [a]
++
         String
" has the wrong number of arguments" forall a. [a] -> [a] -> [a]
++
         forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f))
      if forall c. ReturnValues c -> Bool
isUnnamedReturns (forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p)
         then forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else do
           forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. PassedValue c -> ValueType
pvType forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction a
f) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. OutputValue c -> VariableName
ovName forall a b. (a -> b) -> a -> b
$ forall c. ReturnValues c -> Positional (OutputValue c)
nrNames forall a b. (a -> b) -> a -> b
$ forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p) forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
             (String
"Procedure for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) forall a. [a] -> [a] -> [a]
++
              forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ReturnValues c -> [c]
nrContext forall a b. (a -> b) -> a -> b
$ forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p) forall a. [a] -> [a] -> [a]
++
              String
" has the wrong number of returns" forall a. [a] -> [a] -> [a]
++
              forall a. Show a => [a] -> String
formatFullContextBrace (forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f))
           forall (m :: * -> *) a. Monad m => a -> m a
return ()
      forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedFunction a
f,ExecutableProcedure a
p)
    getPair Maybe (ScopedFunction a)
_ Maybe (ExecutableProcedure a)
_ = forall a. HasCallStack => a
undefined

mapMembers :: (Show c, CollectErrorsM m) =>
  Map.Map VariableName [c] -> Map.Map VariableName [c] -> [DefinedMember c] ->
  m (Map.Map VariableName (VariableValue c))
mapMembers :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Map VariableName [c]
-> Map VariableName [c]
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
mapMembers Map VariableName [c]
readOnly Map VariableName [c]
hidden [DefinedMember c]
ms = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {m :: * -> *}.
ErrorContextM m =>
DefinedMember c
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
update (forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty) [DefinedMember c]
ms where
  update :: DefinedMember c
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
update DefinedMember c
m m (Map VariableName (VariableValue c))
ma = do
    Map VariableName (VariableValue c)
ma' <- m (Map VariableName (VariableValue c))
ma
    case forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName (VariableValue c)
ma' of
         Maybe (VariableValue c)
Nothing ->  forall (m :: * -> *) a. Monad m => a -> m a
return ()
         -- TODO: The error might show things in the wrong order.
         (Just VariableValue c
m0) -> forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Member " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) forall a. [a] -> [a] -> [a]
++
                                     forall a. Show a => [a] -> String
formatFullContextBrace (forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) forall a. [a] -> [a] -> [a]
++
                                     String
" is already defined" forall a. [a] -> [a] -> [a]
++
                                     forall a. Show a => [a] -> String
formatFullContextBrace (forall c. VariableValue c -> [c]
vvContext VariableValue c
m0)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) (forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue (forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) (forall c. DefinedMember c -> SymbolScope
dmScope DefinedMember c
m) (forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) (forall {c}. DefinedMember c -> VariableRule c
memberRule DefinedMember c
m)) Map VariableName (VariableValue c)
ma'
  memberRule :: DefinedMember c -> VariableRule c
memberRule DefinedMember c
m =
    case (forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName [c]
hidden,forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName [c]
readOnly) of
         (Just [c]
c,Maybe [c]
_) -> forall c. [c] -> VariableRule c
VariableHidden   [c]
c
         (Maybe [c]
_,Just [c]
c) -> forall c. [c] -> VariableRule c
VariableReadOnly [c]
c
         (Maybe [c], Maybe [c])
_ -> forall c. VariableRule c
VariableDefault

-- TODO: Most of this duplicates parts of flattenAllConnections.
mergeInternalInheritance :: (Show c, CollectErrorsM m) =>
  CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance cm :: CategoryMap c
cm@(CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm) DefinedCategory c
d = String
"In definition of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContextBrace (forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  let rs2 :: [ValueRefine c]
rs2 = forall c. DefinedCategory c -> [ValueRefine c]
dcRefines DefinedCategory c
d
  let ds2 :: [ValueDefine c]
ds2 = forall c. DefinedCategory c -> [ValueDefine c]
dcDefines DefinedCategory c
d
  ([c]
_,t :: AnyCategory c
t@(ValueConcrete [c]
c Namespace
ns CategoryName
n [PragmaCategory c]
pg [FunctionVisibility c]
fv [ValueParam c]
ps [ValueRefine c]
rs [ValueDefine c]
ds [ParamFilter c]
vs [ScopedFunction c]
fs)) <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getConcreteCategory CategoryMap c
cm (forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d,forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d)
  let c2 :: AnyCategory c
c2 = forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [FunctionVisibility c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
ValueConcrete [c]
c Namespace
ns CategoryName
n [PragmaCategory c]
pg [FunctionVisibility c]
fv [ValueParam c]
ps ([ValueRefine c]
rsforall a. [a] -> [a] -> [a]
++[ValueRefine c]
rs2) ([ValueDefine c]
dsforall a. [a] -> [a] -> [a]
++[ValueDefine c]
ds2) [ParamFilter c]
vs [ScopedFunction c]
fs
  let tm' :: Map CategoryName (AnyCategory c)
tm' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) AnyCategory c
c2 Map CategoryName (AnyCategory c)
tm
  let r :: CategoryResolver c
r = forall c. CategoryMap c -> CategoryResolver c
CategoryResolver (forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm')
  ParamFilters
fm <- forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  let pm :: ParamValues
pm = forall c. AnyCategory c -> ParamValues
getCategoryParamMap AnyCategory c
t
  [ValueRefine c]
rs2' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall {m :: * -> *} {r}.
(CollectErrorsM m, TypeResolver r) =>
r -> ValueRefine c -> m [ValueRefine c]
flattenRefine CategoryResolver c
r) [ValueRefine c]
rs2
  [ValueRefine c]
rs' <- forall (m :: * -> *) r c.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> [ValueRefine c] -> m [ValueRefine c]
mergeRefines CategoryResolver c
r ParamFilters
fm ([ValueRefine c]
rsforall a. [a] -> [a] -> [a]
++[ValueRefine c]
rs2')
  forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
[c] -> CategoryName -> [ValueRefine c] -> m ()
noDuplicateRefines (forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) CategoryName
n [ValueRefine c]
rs'
  [ValueDefine c]
ds' <- forall (m :: * -> *) r c.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> [ValueDefine c] -> m [ValueDefine c]
mergeDefines CategoryResolver c
r ParamFilters
fm ([ValueDefine c]
dsforall a. [a] -> [a] -> [a]
++[ValueDefine c]
ds2)
  forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
[c] -> CategoryName -> [ValueDefine c] -> m ()
noDuplicateDefines (forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d) CategoryName
n [ValueDefine c]
ds'
  let vm :: Map ParamName Variance
vm = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ValueParam c
p -> (forall c. ValueParam c -> ParamName
vpParam ValueParam c
p,forall c. ValueParam c -> Variance
vpVariance ValueParam c
p)) [ValueParam c]
ps
  forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (forall {m :: * -> *} {r} {a}.
(CollectErrorsM m, TypeResolver r, Show a) =>
r -> Map ParamName Variance -> ValueRefine a -> m ()
checkRefinesVariance CategoryResolver c
r Map ParamName Variance
vm) [ValueRefine c]
rs2
  forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (forall {m :: * -> *} {r} {a}.
(CollectErrorsM m, TypeResolver r, Show a) =>
r -> Map ParamName Variance -> ValueDefine a -> m ()
checkDefinesVariance CategoryResolver c
r Map ParamName Variance
vm) [ValueDefine c]
ds2
  [PragmaCategory c]
pg2 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall {m :: * -> *}.
CollectErrorsM m =>
ValueRefine c -> m [PragmaCategory c]
getRefinesPragmas [ValueRefine c]
rs2
  [PragmaCategory c]
pg3 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall {m :: * -> *}.
CollectErrorsM m =>
ValueDefine c -> m [PragmaCategory c]
getDefinesPragmas [ValueDefine c]
ds2
  let fs2 :: [ScopedFunction c]
fs2 = forall {t :: * -> *} {c}.
Foldable t =>
[ScopedFunction c] -> t (ScopedFunction c) -> [ScopedFunction c]
mergeInternalFunctions [ScopedFunction c]
fs (forall c. DefinedCategory c -> [ScopedFunction c]
dcFunctions DefinedCategory c
d)
  [ScopedFunction c]
fs' <- forall c (m :: * -> *) r.
(Show c, CollectErrorsM m, TypeResolver r) =>
r
-> CategoryMap c
-> ParamValues
-> ParamFilters
-> [ValueRefine c]
-> [ValueDefine c]
-> [ScopedFunction c]
-> m [ScopedFunction c]
mergeFunctions CategoryResolver c
r (forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm') ParamValues
pm ParamFilters
fm [ValueRefine c]
rs' [ValueDefine c]
ds' [ScopedFunction c]
fs2
  let c2' :: AnyCategory c
c2' = forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [FunctionVisibility c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
ValueConcrete [c]
c Namespace
ns CategoryName
n ([PragmaCategory c]
pgforall a. [a] -> [a] -> [a]
++[PragmaCategory c]
pg2forall a. [a] -> [a] -> [a]
++[PragmaCategory c]
pg3) [FunctionVisibility c]
fv [ValueParam c]
ps [ValueRefine c]
rs' [ValueDefine c]
ds' [ParamFilter c]
vs [ScopedFunction c]
fs'
  let tm0 :: Map CategoryName (AnyCategory c)
tm0 = (forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) forall k a. Ord k => k -> Map k a -> Map k a
`Map.delete` Map CategoryName (AnyCategory c)
tm
  forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m ()
checkCategoryInstances (forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km Map CategoryName (AnyCategory c)
tm0) [AnyCategory c
c2']
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
Map CategoryName [c]
-> Map CategoryName (AnyCategory c) -> CategoryMap c
CategoryMap Map CategoryName [c]
km forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) AnyCategory c
c2' Map CategoryName (AnyCategory c)
tm
  where
    getRefinesPragmas :: ValueRefine c -> m [PragmaCategory c]
getRefinesPragmas ValueRefine c
rf = do
      ([c]
_,AnyCategory c
t) <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getCategory CategoryMap c
cm (forall c. ValueRefine c -> [c]
vrContext ValueRefine c
rf,TypeInstance -> CategoryName
tiName forall a b. (a -> b) -> a -> b
$ forall c. ValueRefine c -> TypeInstance
vrType ValueRefine c
rf)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall c. [c] -> PragmaCategory c -> PragmaCategory c
prependCategoryPragmaContext forall a b. (a -> b) -> a -> b
$ forall c. ValueRefine c -> [c]
vrContext ValueRefine c
rf) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas AnyCategory c
t
    getDefinesPragmas :: ValueDefine c -> m [PragmaCategory c]
getDefinesPragmas ValueDefine c
df = do
      ([c]
_,AnyCategory c
t) <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getCategory CategoryMap c
cm (forall c. ValueDefine c -> [c]
vdContext ValueDefine c
df,DefinesInstance -> CategoryName
diName forall a b. (a -> b) -> a -> b
$ forall c. ValueDefine c -> DefinesInstance
vdType ValueDefine c
df)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall c. [c] -> PragmaCategory c -> PragmaCategory c
prependCategoryPragmaContext forall a b. (a -> b) -> a -> b
$ forall c. ValueDefine c -> [c]
vdContext ValueDefine c
df) forall a b. (a -> b) -> a -> b
$ forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas AnyCategory c
t
    mergeInternalFunctions :: [ScopedFunction c] -> t (ScopedFunction c) -> [ScopedFunction c]
mergeInternalFunctions [ScopedFunction c]
fs1 = forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {c}.
ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
single (forall {c}.
[ScopedFunction c] -> Map FunctionName (ScopedFunction c)
funcMap [ScopedFunction c]
fs1)
    funcMap :: [ScopedFunction c] -> Map FunctionName (ScopedFunction c)
funcMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,ScopedFunction c
f))
    single :: ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
single ScopedFunction c
f Map FunctionName (ScopedFunction c)
fm =
      case forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ScopedFunction c)
fm of
           Maybe (ScopedFunction c)
Nothing -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) ScopedFunction c
f Map FunctionName (ScopedFunction c)
fm
           Just ScopedFunction c
f2 -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) (ScopedFunction {
               sfContext :: [c]
sfContext = forall c. ScopedFunction c -> [c]
sfContext ScopedFunction c
f,
               sfName :: FunctionName
sfName = forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,
               sfType :: CategoryName
sfType = forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f,
               sfScope :: SymbolScope
sfScope = forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f,
               sfVisibility :: FunctionVisibility c
sfVisibility = forall c. ScopedFunction c -> FunctionVisibility c
sfVisibility ScopedFunction c
f,
               sfArgs :: Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs = forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f,
               sfReturns :: Positional (PassedValue c)
sfReturns = forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction c
f,
               sfParams :: Positional (ValueParam c)
sfParams = forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f,
               sfFilters :: [ParamFilter c]
sfFilters = forall c. ScopedFunction c -> [ParamFilter c]
sfFilters ScopedFunction c
f,
               sfMerges :: [ScopedFunction c]
sfMerges = forall c. ScopedFunction c -> [ScopedFunction c]
sfMerges ScopedFunction c
f forall a. [a] -> [a] -> [a]
++ [ScopedFunction c
f2]
             }) Map FunctionName (ScopedFunction c)
fm
    checkRefinesVariance :: r -> Map ParamName Variance -> ValueRefine a -> m ()
checkRefinesVariance r
r Map ParamName Variance
vm (ValueRefine [a]
c TypeInstance
t) =
      forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Map ParamName Variance -> Variance -> GeneralInstance -> m ()
validateInstanceVariance r
r Map ParamName Variance
vm Variance
Covariant (forall a. (Eq a, Ord a) => a -> GeneralType a
singleType forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance TypeInstance
t) forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        String
"In " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeInstance
t forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
    checkDefinesVariance :: r -> Map ParamName Variance -> ValueDefine a -> m ()
checkDefinesVariance r
r Map ParamName Variance
vm (ValueDefine [a]
c DefinesInstance
t) =
      forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Map ParamName Variance -> Variance -> DefinesInstance -> m ()
validateDefinesVariance r
r Map ParamName Variance
vm Variance
Covariant DefinesInstance
t forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        String
"In " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DefinesInstance
t forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
    flattenRefine :: r -> ValueRefine c -> m [ValueRefine c]
flattenRefine r
r ra :: ValueRefine c
ra@(ValueRefine [c]
c TypeInstance
t) = do
      ([c]
_,AnyCategory c
t2) <- forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getValueCategory CategoryMap c
cm ([c]
c,TypeInstance -> CategoryName
tiName TypeInstance
t)
      [ValueRefine c]
rs <- forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (forall {m :: * -> *} {r} {c}.
(TypeResolver r, CollectErrorsM m) =>
r -> ValueRefine c -> ValueRefine c -> m (ValueRefine c)
singleRefine r
r ValueRefine c
ra) (forall c. AnyCategory c -> [ValueRefine c]
getCategoryRefines AnyCategory c
t2)
      forall (m :: * -> *) a. Monad m => a -> m a
return (ValueRefine c
raforall a. a -> [a] -> [a]
:[ValueRefine c]
rs)
    singleRefine :: r -> ValueRefine c -> ValueRefine c -> m (ValueRefine c)
singleRefine r
r (ValueRefine [c]
c TypeInstance
t) (ValueRefine [c]
c2 TypeInstance
t2) = do
      InstanceParams
ps <- forall r (m :: * -> *).
(TypeResolver r, CollectErrorsM m) =>
r -> TypeInstance -> CategoryName -> m InstanceParams
trRefines r
r TypeInstance
t (TypeInstance -> CategoryName
tiName TypeInstance
t2)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine ([c]
cforall a. [a] -> [a] -> [a]
++[c]
c2) (CategoryName -> InstanceParams -> TypeInstance
TypeInstance (TypeInstance -> CategoryName
tiName TypeInstance
t2) InstanceParams
ps)

replaceSelfMember :: (Show c, CollectErrorsM m) =>
  GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember :: forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
GeneralInstance -> DefinedMember c -> m (DefinedMember c)
replaceSelfMember GeneralInstance
self (DefinedMember [c]
c SymbolScope
s ValueType
t VariableName
n Maybe (Expression c)
i) = do
  ValueType
t' <- forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> ValueType -> m ValueType
replaceSelfValueType GeneralInstance
self ValueType
t
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> SymbolScope
-> ValueType
-> VariableName
-> Maybe (Expression c)
-> DefinedMember c
DefinedMember [c]
c SymbolScope
s ValueType
t' VariableName
n Maybe (Expression c)
i