{- -----------------------------------------------------------------------------
Copyright 2019-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 Types.DefinedCategory (
  DefinedCategory(..),
  DefinedMember(..),
  PragmaDefined(..),
  VariableRule(..),
  VariableValue(..),
  isInitialized,
  isFlatCleanup,
  isMembersHidden,
  isMembersReadOnly,
  mapMembers,
  mergeInternalInheritance,
  pairProceduresToFunctions,
  replaceSelfMember,
  setInternalFunctions,
) where

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

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


data DefinedCategory c =
  DefinedCategory {
    DefinedCategory c -> [c]
dcContext :: [c],
    DefinedCategory c -> CategoryName
dcName :: CategoryName,
    DefinedCategory c -> [PragmaDefined c]
dcPragmas :: [PragmaDefined c],
    DefinedCategory c -> [ValueRefine c]
dcRefines :: [ValueRefine c],
    DefinedCategory c -> [ValueDefine c]
dcDefines :: [ValueDefine c],
    DefinedCategory c -> [DefinedMember c]
dcMembers :: [DefinedMember c],
    DefinedCategory c -> [ExecutableProcedure c]
dcProcedures :: [ExecutableProcedure c],
    DefinedCategory c -> [ScopedFunction c]
dcFunctions :: [ScopedFunction c]
  }
  deriving (Int -> DefinedCategory c -> ShowS
[DefinedCategory c] -> ShowS
DefinedCategory c -> String
(Int -> DefinedCategory c -> ShowS)
-> (DefinedCategory c -> String)
-> ([DefinedCategory c] -> ShowS)
-> Show (DefinedCategory c)
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 {
    DefinedMember c -> [c]
dmContext :: [c],
    DefinedMember c -> SymbolScope
dmScope :: SymbolScope,
    DefinedMember c -> ValueType
dmType :: ValueType,
    DefinedMember c -> VariableName
dmName :: VariableName,
    DefinedMember c -> Maybe (Expression c)
dmInit :: Maybe (Expression c)
  }
  deriving (Int -> DefinedMember c -> ShowS
[DefinedMember c] -> ShowS
DefinedMember c -> String
(Int -> DefinedMember c -> ShowS)
-> (DefinedMember c -> String)
-> ([DefinedMember c] -> ShowS)
-> Show (DefinedMember c)
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 :: DefinedMember c -> Bool
isInitialized = Maybe (Expression c) -> Bool
forall a. Maybe a -> Bool
check (Maybe (Expression c) -> Bool)
-> (DefinedMember c -> Maybe (Expression c))
-> DefinedMember c
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedMember c -> Maybe (Expression 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 {
    PragmaDefined c -> [c]
mroContext :: [c],
    PragmaDefined c -> [VariableName]
mroMembers :: [VariableName]
  } |
  MembersHidden {
    PragmaDefined c -> [c]
mhContext :: [c],
    PragmaDefined c -> [VariableName]
mhMembers :: [VariableName]
  } |
  FlatCleanup {
    PragmaDefined c -> [c]
fcContext :: [c],
    PragmaDefined c -> VariableName
fcMember :: VariableName
  }
  deriving (Int -> PragmaDefined c -> ShowS
[PragmaDefined c] -> ShowS
PragmaDefined c -> String
(Int -> PragmaDefined c -> ShowS)
-> (PragmaDefined c -> String)
-> ([PragmaDefined c] -> ShowS)
-> Show (PragmaDefined c)
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 :: PragmaDefined c -> Bool
isMembersReadOnly (MembersReadOnly [c]
_ [VariableName]
_) = Bool
True
isMembersReadOnly PragmaDefined c
_                     = Bool
False

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

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

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

data VariableValue c =
  VariableValue {
    VariableValue c -> [c]
vvContext :: [c],
    VariableValue c -> SymbolScope
vvScope :: SymbolScope,
    VariableValue c -> ValueType
vvType :: ValueType,
    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) = ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableRule c -> String
forall a. Show a => VariableRule a -> String
format VariableRule c
ro where
    format :: VariableRule a -> String
format (VariableReadOnly [a]
c2) = String
" (read-only at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    format (VariableHidden [a]
c2)   = String
" (hidden at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c2 String -> ShowS
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 :: r
-> AnyCategory c
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
setInternalFunctions r
r AnyCategory c
t [ScopedFunction c]
fs = do
  ParamFilters
fm <- AnyCategory c -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  (ScopedFunction c
 -> m (Map FunctionName (ScopedFunction c))
 -> m (Map FunctionName (ScopedFunction c)))
-> m (Map FunctionName (ScopedFunction c))
-> [ScopedFunction c]
-> m (Map FunctionName (ScopedFunction c))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ParamFilters
-> ScopedFunction c
-> m (Map FunctionName (ScopedFunction c))
-> m (Map FunctionName (ScopedFunction c))
forall (m :: * -> *).
CollectErrorsM m =>
ParamFilters
-> ScopedFunction c
-> m (Map FunctionName (ScopedFunction c))
-> m (Map FunctionName (ScopedFunction c))
update ParamFilters
fm) (Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall (m :: * -> *) a. Monad m => a -> m a
return Map FunctionName (ScopedFunction c)
start) [ScopedFunction c]
fs where
  start :: Map FunctionName (ScopedFunction c)
start = [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FunctionName, ScopedFunction c)]
 -> Map FunctionName (ScopedFunction c))
-> [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ (ScopedFunction c -> (FunctionName, ScopedFunction c))
-> [ScopedFunction c] -> [(FunctionName, ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,ScopedFunction c
f)) ([ScopedFunction c] -> [(FunctionName, ScopedFunction c)])
-> [ScopedFunction c] -> [(FunctionName, ScopedFunction c)]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [ScopedFunction c]
forall c. AnyCategory c -> [ScopedFunction c]
getCategoryFunctions AnyCategory c
t
  pm :: ParamValues
pm = AnyCategory c -> ParamValues
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 Positional (PassedValue c)
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs2 [ScopedFunction c]
ms) m (Map FunctionName (ScopedFunction c))
fa = do
    r -> AnyCategory c -> ScopedFunction c -> m ()
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 FunctionName
-> Map FunctionName (ScopedFunction c) -> Maybe (ScopedFunction c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ScopedFunction c)
fa' of
         Maybe (ScopedFunction c)
Nothing -> Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FunctionName (ScopedFunction c)
 -> m (Map FunctionName (ScopedFunction c)))
-> Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall a b. (a -> b) -> a -> b
$ FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
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
_ Positional (PassedValue c)
_ Positional (PassedValue c)
_ Positional (ValueParam c)
_ [ParamFilter c]
_ [ScopedFunction c]
ms2)) -> do
           (String
"In function merge:\n---\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall a. Show a => a -> String
show ScopedFunction c
f0 String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
"\n  ->\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall a. Show a => a -> String
show ScopedFunction c
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n---\n") String -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
              FunctionType
f0' <- ScopedFunction c -> m FunctionType
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f0
              FunctionType
f' <- ScopedFunction c -> m FunctionType
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f
              r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> FunctionType
-> FunctionType
-> m ()
checkFunctionConvert r
r ParamFilters
fm ParamValues
pm FunctionType
f0' FunctionType
f'
           Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FunctionName (ScopedFunction c)
 -> m (Map FunctionName (ScopedFunction c)))
-> Map FunctionName (ScopedFunction c)
-> m (Map FunctionName (ScopedFunction c))
forall a b. (a -> b) -> a -> b
$ FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
n ([c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> Positional (PassedValue c)
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
forall c.
[c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> Positional (PassedValue c)
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
ScopedFunction ([c]
c[c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++[c]
c2) FunctionName
n CategoryName
t2 SymbolScope
s Positional (PassedValue c)
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs2 ([ScopedFunction c
f0][ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++[ScopedFunction c]
ms[ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall 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 :: 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 <- (ExecutableProcedure c
 -> m (Map FunctionName (ExecutableProcedure c))
 -> m (Map FunctionName (ExecutableProcedure c)))
-> m (Map FunctionName (ExecutableProcedure c))
-> [ExecutableProcedure c]
-> m (Map FunctionName (ExecutableProcedure c))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ExecutableProcedure c
-> m (Map FunctionName (ExecutableProcedure c))
-> m (Map FunctionName (ExecutableProcedure c))
forall (m :: * -> *) c.
(ErrorContextM m, Show c) =>
ExecutableProcedure c
-> m (Map FunctionName (ExecutableProcedure c))
-> m (Map FunctionName (ExecutableProcedure c))
updateProcedure (Map FunctionName (ExecutableProcedure c)
-> m (Map FunctionName (ExecutableProcedure c))
forall (m :: * -> *) a. Monad m => a -> m a
return Map FunctionName (ExecutableProcedure c)
forall k a. Map k a
Map.empty) [ExecutableProcedure c]
ps
  let allNames :: Set FunctionName
allNames = Set FunctionName -> Set FunctionName -> Set FunctionName
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Map FunctionName (ScopedFunction c) -> Set FunctionName
forall k a. Map k a -> Set k
Map.keysSet Map FunctionName (ScopedFunction c)
fa) (Map FunctionName (ExecutableProcedure c) -> Set FunctionName
forall k a. Map k a -> Set k
Map.keysSet Map FunctionName (ExecutableProcedure c)
pa)
  (FunctionName
 -> m [(ScopedFunction c, ExecutableProcedure c)]
 -> m [(ScopedFunction c, ExecutableProcedure c)])
-> m [(ScopedFunction c, ExecutableProcedure c)]
-> [FunctionName]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Map FunctionName (ScopedFunction c)
-> Map FunctionName (ExecutableProcedure c)
-> FunctionName
-> m [(ScopedFunction c, ExecutableProcedure c)]
-> m [(ScopedFunction c, ExecutableProcedure c)]
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) ([(ScopedFunction c, ExecutableProcedure c)]
-> m [(ScopedFunction c, ExecutableProcedure c)]
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([FunctionName] -> m [(ScopedFunction c, ExecutableProcedure c)])
-> [FunctionName] -> m [(ScopedFunction c, ExecutableProcedure c)]
forall a b. (a -> b) -> a -> b
$ Set FunctionName -> [FunctionName]
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 ExecutableProcedure c -> FunctionName
forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p FunctionName
-> Map FunctionName (ExecutableProcedure c)
-> Maybe (ExecutableProcedure c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ExecutableProcedure c)
pa' of
           Maybe (ExecutableProcedure c)
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           -- TODO: The error might show things in the wrong order.
           (Just ExecutableProcedure c
p0) -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Procedure " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ExecutableProcedure c -> FunctionName
forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure c
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ExecutableProcedure c -> [c]
forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure c
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       String
" is already defined" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ExecutableProcedure c -> [c]
forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure c
p0)
      Map FunctionName (ExecutableProcedure c)
-> m (Map FunctionName (ExecutableProcedure c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FunctionName (ExecutableProcedure c)
 -> m (Map FunctionName (ExecutableProcedure c)))
-> Map FunctionName (ExecutableProcedure c)
-> m (Map FunctionName (ExecutableProcedure c))
forall a b. (a -> b) -> a -> b
$ FunctionName
-> ExecutableProcedure c
-> Map FunctionName (ExecutableProcedure c)
-> Map FunctionName (ExecutableProcedure c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ExecutableProcedure c -> FunctionName
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 <- Maybe (ScopedFunction a)
-> Maybe (ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
forall (m :: * -> *) a a.
(Show a, Show a, CollectErrorsM m) =>
Maybe (ScopedFunction a)
-> Maybe (ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
getPair (k
n k -> Map k (ScopedFunction a) -> Maybe (ScopedFunction a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (ScopedFunction a)
fa2) (k
n k -> Map k (ExecutableProcedure a) -> Maybe (ExecutableProcedure a)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map k (ExecutableProcedure a)
pa)
      [(ScopedFunction a, ExecutableProcedure a)]
-> m [(ScopedFunction a, ExecutableProcedure a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((ScopedFunction a, ExecutableProcedure a)
p(ScopedFunction a, ExecutableProcedure a)
-> [(ScopedFunction a, ExecutableProcedure a)]
-> [(ScopedFunction a, ExecutableProcedure a)]
forall 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 =
      String -> m (ScopedFunction a, ExecutableProcedure a)
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction a, ExecutableProcedure a))
-> String -> m (ScopedFunction a, ExecutableProcedure a)
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction a -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ScopedFunction a -> [a]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
" has no procedure definition"
    getPair Maybe (ScopedFunction a)
Nothing (Just ExecutableProcedure a
p) =
      String -> m (ScopedFunction a, ExecutableProcedure a)
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ScopedFunction a, ExecutableProcedure a))
-> String -> m (ScopedFunction a, ExecutableProcedure a)
forall a b. (a -> b) -> a -> b
$ String
"Procedure " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ExecutableProcedure a -> FunctionName
forall c. ExecutableProcedure c -> FunctionName
epName ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ExecutableProcedure a -> [a]
forall c. ExecutableProcedure c -> [c]
epContext ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
" does not correspond to a function"
    getPair (Just ScopedFunction a
f) (Just ExecutableProcedure a
p) = do
      (PassedValue a -> InputValue a -> m (PassedValue a, InputValue a))
-> Positional (PassedValue a) -> Positional (InputValue a) -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ PassedValue a -> InputValue a -> m (PassedValue a, InputValue a)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair (ScopedFunction a -> Positional (PassedValue a)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfArgs ScopedFunction a
f) (ArgValues a -> Positional (InputValue a)
forall c. ArgValues c -> Positional (InputValue c)
avNames (ArgValues a -> Positional (InputValue a))
-> ArgValues a -> Positional (InputValue a)
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ArgValues a
forall c. ExecutableProcedure c -> ArgValues c
epArgs ExecutableProcedure a
p) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
        (String
"Procedure for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction a -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
         [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ArgValues a -> [a]
forall c. ArgValues c -> [c]
avContext (ArgValues a -> [a]) -> ArgValues a -> [a]
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ArgValues a
forall c. ExecutableProcedure c -> ArgValues c
epArgs ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
         String
" has the wrong number of arguments" String -> ShowS
forall a. [a] -> [a] -> [a]
++
         [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ScopedFunction a -> [a]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f))
      if ReturnValues a -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns (ExecutableProcedure a -> ReturnValues a
forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p)
         then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else do
           (PassedValue a
 -> OutputValue a -> m (PassedValue a, OutputValue a))
-> Positional (PassedValue a) -> Positional (OutputValue a) -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ PassedValue a -> OutputValue a -> m (PassedValue a, OutputValue a)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair (ScopedFunction a -> Positional (PassedValue a)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction a
f) (ReturnValues a -> Positional (OutputValue a)
forall c. ReturnValues c -> Positional (OutputValue c)
nrNames (ReturnValues a -> Positional (OutputValue a))
-> ReturnValues a -> Positional (OutputValue a)
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ReturnValues a
forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
             (String
"Procedure for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction a -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++
              [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ReturnValues a -> [a]
forall c. ReturnValues c -> [c]
nrContext (ReturnValues a -> [a]) -> ReturnValues a -> [a]
forall a b. (a -> b) -> a -> b
$ ExecutableProcedure a -> ReturnValues a
forall c. ExecutableProcedure c -> ReturnValues c
epReturns ExecutableProcedure a
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
" has the wrong number of returns" String -> ShowS
forall a. [a] -> [a] -> [a]
++
              [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ScopedFunction a -> [a]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction a
f))
           () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (ScopedFunction a, ExecutableProcedure a)
-> m (ScopedFunction a, ExecutableProcedure a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedFunction a
f,ExecutableProcedure a
p)
    getPair Maybe (ScopedFunction a)
_ Maybe (ExecutableProcedure a)
_ = m (ScopedFunction a, 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 :: 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 = (DefinedMember c
 -> m (Map VariableName (VariableValue c))
 -> m (Map VariableName (VariableValue c)))
-> m (Map VariableName (VariableValue c))
-> [DefinedMember c]
-> m (Map VariableName (VariableValue c))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DefinedMember c
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *).
ErrorContextM m =>
DefinedMember c
-> m (Map VariableName (VariableValue c))
-> m (Map VariableName (VariableValue c))
update (Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *) a. Monad m => a -> m a
return Map VariableName (VariableValue c)
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 DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m VariableName
-> Map VariableName (VariableValue c) -> Maybe (VariableValue c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName (VariableValue c)
ma' of
         Maybe (VariableValue c)
Nothing ->  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         -- TODO: The error might show things in the wrong order.
         (Just VariableValue c
m0) -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Member " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (DefinedMember c -> [c]
forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     String
" is already defined" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (VariableValue c -> [c]
forall c. VariableValue c -> [c]
vvContext VariableValue c
m0)
    Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map VariableName (VariableValue c)
 -> m (Map VariableName (VariableValue c)))
-> Map VariableName (VariableValue c)
-> m (Map VariableName (VariableValue c))
forall a b. (a -> b) -> a -> b
$ VariableName
-> VariableValue c
-> Map VariableName (VariableValue c)
-> Map VariableName (VariableValue c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue (DefinedMember c -> [c]
forall c. DefinedMember c -> [c]
dmContext DefinedMember c
m) (DefinedMember c -> SymbolScope
forall c. DefinedMember c -> SymbolScope
dmScope DefinedMember c
m) (DefinedMember c -> ValueType
forall c. DefinedMember c -> ValueType
dmType DefinedMember c
m) (DefinedMember c -> VariableRule c
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 (DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m VariableName -> Map VariableName [c] -> Maybe [c]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName [c]
hidden,DefinedMember c -> VariableName
forall c. DefinedMember c -> VariableName
dmName DefinedMember c
m VariableName -> Map VariableName [c] -> Maybe [c]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map VariableName [c]
readOnly) of
         (Just [c]
c,Maybe [c]
_) -> [c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableHidden   [c]
c
         (Maybe [c]
_,Just [c]
c) -> [c] -> VariableRule c
forall c. [c] -> VariableRule c
VariableReadOnly [c]
c
         (Maybe [c], Maybe [c])
_ -> VariableRule 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 :: CategoryMap c -> DefinedCategory c -> m (CategoryMap c)
mergeInternalInheritance CategoryMap c
tm DefinedCategory c
d = do
  let rs2 :: [ValueRefine c]
rs2 = DefinedCategory c -> [ValueRefine c]
forall c. DefinedCategory c -> [ValueRefine c]
dcRefines DefinedCategory c
d
  let ds2 :: [ValueDefine c]
ds2 = DefinedCategory c -> [ValueDefine c]
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 [ValueParam c]
ps [ValueRefine c]
rs [ValueDefine c]
ds [ParamFilter c]
vs [ScopedFunction c]
fs)) <- 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
tm (DefinedCategory c -> [c]
forall c. DefinedCategory c -> [c]
dcContext DefinedCategory c
d,DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d)
  let c2 :: AnyCategory c
c2 = [c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
ValueConcrete [c]
c Namespace
ns CategoryName
n [PragmaCategory c]
pg [ValueParam c]
ps ([ValueRefine c]
rs[ValueRefine c] -> [ValueRefine c] -> [ValueRefine c]
forall a. [a] -> [a] -> [a]
++[ValueRefine c]
rs2) ([ValueDefine c]
ds[ValueDefine c] -> [ValueDefine c] -> [ValueDefine c]
forall a. [a] -> [a] -> [a]
++[ValueDefine c]
ds2) [ParamFilter c]
vs [ScopedFunction c]
fs
  let tm' :: CategoryMap c
tm' = CategoryName -> AnyCategory c -> CategoryMap c -> CategoryMap c
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) AnyCategory c
c2 CategoryMap c
tm
  let r :: CategoryResolver c
r = CategoryMap c -> CategoryResolver c
forall c. CategoryMap c -> CategoryResolver c
CategoryResolver CategoryMap c
tm'
  ParamFilters
fm <- AnyCategory c -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
AnyCategory c -> m ParamFilters
getCategoryFilterMap AnyCategory c
t
  let pm :: ParamValues
pm = AnyCategory c -> ParamValues
forall c. AnyCategory c -> ParamValues
getCategoryParamMap AnyCategory c
t
  [ValueRefine c]
rs' <- CategoryResolver c
-> ParamFilters -> [ValueRefine c] -> m [ValueRefine c]
forall (m :: * -> *) r c.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> [ValueRefine c] -> m [ValueRefine c]
mergeRefines CategoryResolver c
r ParamFilters
fm ([ValueRefine c]
rs[ValueRefine c] -> [ValueRefine c] -> [ValueRefine c]
forall a. [a] -> [a] -> [a]
++[ValueRefine c]
rs2)
  [c] -> CategoryName -> [ValueRefine c] -> m ()
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
[c] -> CategoryName -> [ValueRefine c] -> m ()
noDuplicateRefines [] CategoryName
n [ValueRefine c]
rs'
  [ValueDefine c]
ds' <- CategoryResolver c
-> ParamFilters -> [ValueDefine c] -> m [ValueDefine c]
forall (m :: * -> *) r c.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> [ValueDefine c] -> m [ValueDefine c]
mergeDefines CategoryResolver c
r ParamFilters
fm ([ValueDefine c]
ds[ValueDefine c] -> [ValueDefine c] -> [ValueDefine c]
forall a. [a] -> [a] -> [a]
++[ValueDefine c]
ds2)
  [c] -> CategoryName -> [ValueDefine c] -> m ()
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
[c] -> CategoryName -> [ValueDefine c] -> m ()
noDuplicateDefines [] CategoryName
n [ValueDefine c]
ds'
  [PragmaCategory c]
pg2 <- ([[PragmaCategory c]] -> [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[PragmaCategory c]] -> [PragmaCategory c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[PragmaCategory c]] -> m [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (ValueRefine c -> m [PragmaCategory c])
-> [ValueRefine c] -> m [[PragmaCategory c]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ValueRefine c -> m [PragmaCategory c]
forall (m :: * -> *).
CollectErrorsM m =>
ValueRefine c -> m [PragmaCategory c]
getRefinesPragmas [ValueRefine c]
rs2
  [PragmaCategory c]
pg3 <- ([[PragmaCategory c]] -> [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[PragmaCategory c]] -> [PragmaCategory c]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[PragmaCategory c]] -> m [PragmaCategory c])
-> m [[PragmaCategory c]] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (ValueDefine c -> m [PragmaCategory c])
-> [ValueDefine c] -> m [[PragmaCategory c]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ValueDefine c -> m [PragmaCategory c]
forall (m :: * -> *).
CollectErrorsM m =>
ValueDefine c -> m [PragmaCategory c]
getDefinesPragmas [ValueDefine c]
ds2
  let fs2 :: [ScopedFunction c]
fs2 = [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall (t :: * -> *) c.
Foldable t =>
[ScopedFunction c] -> t (ScopedFunction c) -> [ScopedFunction c]
mergeInternalFunctions [ScopedFunction c]
fs (DefinedCategory c -> [ScopedFunction c]
forall c. DefinedCategory c -> [ScopedFunction c]
dcFunctions DefinedCategory c
d)
  [ScopedFunction c]
fs' <- CategoryResolver c
-> CategoryMap c
-> ParamValues
-> ParamFilters
-> [ValueRefine c]
-> [ValueDefine c]
-> [ScopedFunction c]
-> m [ScopedFunction c]
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 CategoryMap c
tm' ParamValues
pm ParamFilters
fm [ValueRefine c]
rs' [ValueDefine c]
ds' [ScopedFunction c]
fs2
  let c2' :: AnyCategory c
c2' = [c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
ValueConcrete [c]
c Namespace
ns CategoryName
n ([PragmaCategory c]
pg[PragmaCategory c] -> [PragmaCategory c] -> [PragmaCategory c]
forall a. [a] -> [a] -> [a]
++[PragmaCategory c]
pg2[PragmaCategory c] -> [PragmaCategory c] -> [PragmaCategory c]
forall a. [a] -> [a] -> [a]
++[PragmaCategory c]
pg3) [ValueParam c]
ps [ValueRefine c]
rs' [ValueDefine c]
ds' [ParamFilter c]
vs [ScopedFunction c]
fs'
  let tm0 :: CategoryMap c
tm0 = (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) CategoryName -> CategoryMap c -> CategoryMap c
forall k a. Ord k => k -> Map k a -> Map k a
`Map.delete` CategoryMap c
tm
  CategoryMap c -> [AnyCategory c] -> m ()
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> [AnyCategory c] -> m ()
checkCategoryInstances CategoryMap c
tm0 [AnyCategory c
c2']
  CategoryMap c -> m (CategoryMap c)
forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryMap c -> m (CategoryMap c))
-> CategoryMap c -> m (CategoryMap c)
forall a b. (a -> b) -> a -> b
$ CategoryName -> AnyCategory c -> CategoryMap c -> CategoryMap c
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (DefinedCategory c -> CategoryName
forall c. DefinedCategory c -> CategoryName
dcName DefinedCategory c
d) AnyCategory c
c2' CategoryMap c
tm
  where
    getRefinesPragmas :: ValueRefine c -> m [PragmaCategory c]
getRefinesPragmas ValueRefine c
rf = 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)
getCategory CategoryMap c
tm (ValueRefine c -> [c]
forall c. ValueRefine c -> [c]
vrContext ValueRefine c
rf,TypeInstance -> CategoryName
tiName (TypeInstance -> CategoryName) -> TypeInstance -> CategoryName
forall a b. (a -> b) -> a -> b
$ ValueRefine c -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType ValueRefine c
rf)
      [PragmaCategory c] -> m [PragmaCategory c]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PragmaCategory c] -> m [PragmaCategory c])
-> [PragmaCategory c] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (PragmaCategory c -> PragmaCategory c)
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> [a] -> [b]
map ([c] -> PragmaCategory c -> PragmaCategory c
forall c. [c] -> PragmaCategory c -> PragmaCategory c
prependCategoryPragmaContext ([c] -> PragmaCategory c -> PragmaCategory c)
-> [c] -> PragmaCategory c -> PragmaCategory c
forall a b. (a -> b) -> a -> b
$ ValueRefine c -> [c]
forall c. ValueRefine c -> [c]
vrContext ValueRefine c
rf) ([PragmaCategory c] -> [PragmaCategory c])
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [PragmaCategory c]
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) <- CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], CategoryName) -> m ([c], AnyCategory c)
getCategory CategoryMap c
tm (ValueDefine c -> [c]
forall c. ValueDefine c -> [c]
vdContext ValueDefine c
df,DefinesInstance -> CategoryName
diName (DefinesInstance -> CategoryName)
-> DefinesInstance -> CategoryName
forall a b. (a -> b) -> a -> b
$ ValueDefine c -> DefinesInstance
forall c. ValueDefine c -> DefinesInstance
vdType ValueDefine c
df)
      [PragmaCategory c] -> m [PragmaCategory c]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PragmaCategory c] -> m [PragmaCategory c])
-> [PragmaCategory c] -> m [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ (PragmaCategory c -> PragmaCategory c)
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> [a] -> [b]
map ([c] -> PragmaCategory c -> PragmaCategory c
forall c. [c] -> PragmaCategory c -> PragmaCategory c
prependCategoryPragmaContext ([c] -> PragmaCategory c -> PragmaCategory c)
-> [c] -> PragmaCategory c -> PragmaCategory c
forall a b. (a -> b) -> a -> b
$ ValueDefine c -> [c]
forall c. ValueDefine c -> [c]
vdContext ValueDefine c
df) ([PragmaCategory c] -> [PragmaCategory c])
-> [PragmaCategory c] -> [PragmaCategory c]
forall a b. (a -> b) -> a -> b
$ AnyCategory c -> [PragmaCategory c]
forall c. AnyCategory c -> [PragmaCategory c]
getCategoryPragmas AnyCategory c
t
    mergeInternalFunctions :: [ScopedFunction c] -> t (ScopedFunction c) -> [ScopedFunction c]
mergeInternalFunctions [ScopedFunction c]
fs1 = Map FunctionName (ScopedFunction c) -> [ScopedFunction c]
forall k a. Map k a -> [a]
Map.elems (Map FunctionName (ScopedFunction c) -> [ScopedFunction c])
-> (t (ScopedFunction c) -> Map FunctionName (ScopedFunction c))
-> t (ScopedFunction c)
-> [ScopedFunction c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c
 -> Map FunctionName (ScopedFunction c)
 -> Map FunctionName (ScopedFunction c))
-> Map FunctionName (ScopedFunction c)
-> t (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall c.
ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
single ([ScopedFunction c] -> Map FunctionName (ScopedFunction c)
forall c. [ScopedFunction c] -> Map FunctionName (ScopedFunction c)
funcMap [ScopedFunction c]
fs1)
    funcMap :: [ScopedFunction c] -> Map FunctionName (ScopedFunction c)
funcMap = [(FunctionName, ScopedFunction c)]
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FunctionName, ScopedFunction c)]
 -> Map FunctionName (ScopedFunction c))
-> ([ScopedFunction c] -> [(FunctionName, ScopedFunction c)])
-> [ScopedFunction c]
-> Map FunctionName (ScopedFunction c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScopedFunction c -> (FunctionName, ScopedFunction c))
-> [ScopedFunction c] -> [(FunctionName, ScopedFunction c)]
forall a b. (a -> b) -> [a] -> [b]
map (\ScopedFunction c
f -> (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,ScopedFunction c
f))
    single :: ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
single ScopedFunction c
f Map FunctionName (ScopedFunction c)
fm =
      case ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f FunctionName
-> Map FunctionName (ScopedFunction c) -> Maybe (ScopedFunction c)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map FunctionName (ScopedFunction c)
fm of
           Maybe (ScopedFunction c)
Nothing -> FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) ScopedFunction c
f Map FunctionName (ScopedFunction c)
fm
           Just ScopedFunction c
f2 -> FunctionName
-> ScopedFunction c
-> Map FunctionName (ScopedFunction c)
-> Map FunctionName (ScopedFunction c)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) (ScopedFunction :: forall c.
[c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> Positional (PassedValue c)
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
ScopedFunction {
               sfContext :: [c]
sfContext = ScopedFunction c -> [c]
forall c. ScopedFunction c -> [c]
sfContext ScopedFunction c
f,
               sfName :: FunctionName
sfName = ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f,
               sfType :: CategoryName
sfType = ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f,
               sfScope :: SymbolScope
sfScope = ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f,
               sfArgs :: Positional (PassedValue c)
sfArgs = ScopedFunction c -> Positional (PassedValue c)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfArgs ScopedFunction c
f,
               sfReturns :: Positional (PassedValue c)
sfReturns = ScopedFunction c -> Positional (PassedValue c)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction c
f,
               sfParams :: Positional (ValueParam c)
sfParams = ScopedFunction c -> Positional (ValueParam c)
forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f,
               sfFilters :: [ParamFilter c]
sfFilters = ScopedFunction c -> [ParamFilter c]
forall c. ScopedFunction c -> [ParamFilter c]
sfFilters ScopedFunction c
f,
               sfMerges :: [ScopedFunction c]
sfMerges = ScopedFunction c -> [ScopedFunction c]
forall c. ScopedFunction c -> [ScopedFunction c]
sfMerges ScopedFunction c
f [ScopedFunction c] -> [ScopedFunction c] -> [ScopedFunction c]
forall a. [a] -> [a] -> [a]
++ [ScopedFunction c
f2]
             }) Map FunctionName (ScopedFunction c)
fm

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