{- -----------------------------------------------------------------------------
Copyright 2019-2020 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 CPP #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Compilation.CompilerState (
  CleanupSetup(..),
  CompilerContext(..),
  CompiledData(..),
  CompilerState,
  ExpressionType,
  LoopSetup(..),
  JumpType(..),
  MemberValue(..),
  ReturnVariable(..),
  (<???),
  (???>),
  (<!!!),
  (!!!>),
  concatM,
  csAddVariable,
  csAllFilters,
  csCheckValueInit,
  csCheckVariableInit,
  csClearOutput,
  csCurrentScope,
  csExprLookup,
  csGetCategoryFunction,
  csGetCleanup,
  csGetLoop,
  csGetNoTrace,
  csGetOutput,
  csGetParamScope,
  csGetTypeFunction,
  csGetVariable,
  csInheritReturns,
  csIsNamedReturns,
  csIsUnreachable,
  csPrimNamedReturns,
  csPushCleanup,
  csRegisterReturn,
  csReleaseExprMacro,
  csReserveExprMacro,
  csRequiresTypes,
  csResolver,
  csSameType,
  csSetJumpType,
  csSetNoTrace,
  csStartCleanup,
  csStartLoop,
  csUpdateAssigned,
  csWrite,
  getCleanContext,
  isLoopBoundary,
  resetBackgroundStateT,
  runDataCompiler,
) where

import Control.Monad.Trans (lift)
import Control.Monad.Trans.State (StateT(..),execStateT,get,mapStateT,put)
import Data.Functor
import Prelude hiding (foldr)
import qualified Data.Set as Set

#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup
#endif

import Base.CompileError
import Types.DefinedCategory
import Types.Positional
import Types.Pragma (MacroName)
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


type CompilerState a m = StateT a m

class (Functor m, Monad m) => CompilerContext c m s a | a -> c s where
  ccCurrentScope :: a -> m SymbolScope
  ccResolver :: a -> m AnyTypeResolver
  ccSameType :: a -> TypeInstance -> m Bool
  ccAllFilters :: a -> m ParamFilters
  ccGetParamScope :: a -> ParamName -> m SymbolScope
  ccRequiresTypes :: a -> Set.Set CategoryName -> m a
  ccGetRequired :: a -> m (Set.Set CategoryName)
  ccGetCategoryFunction :: a -> [c] -> Maybe CategoryName -> FunctionName -> m (ScopedFunction c)
  ccGetTypeFunction :: a -> [c] -> Maybe GeneralInstance -> FunctionName -> m (ScopedFunction c)
  ccCheckValueInit :: a -> [c] -> TypeInstance -> ExpressionType -> Positional GeneralInstance -> m ()
  ccGetVariable :: a -> [c] -> VariableName -> m (VariableValue c)
  ccAddVariable :: a -> [c] -> VariableName -> VariableValue c -> m a
  ccCheckVariableInit :: a -> [c] -> VariableName -> m ()
  ccWrite :: a -> s -> m a
  ccGetOutput :: a -> m s
  ccClearOutput :: a -> m a
  ccUpdateAssigned :: a -> VariableName -> m a
  ccInheritReturns :: a -> [a] -> m a
  ccRegisterReturn :: a -> [c] -> Maybe ExpressionType -> m a
  ccPrimNamedReturns :: a -> m [ReturnVariable]
  ccIsUnreachable :: a -> m Bool
  ccIsNamedReturns :: a -> m Bool
  ccSetJumpType :: a -> JumpType -> m a
  ccStartLoop :: a -> LoopSetup s -> m a
  ccGetLoop :: a -> m (LoopSetup s)
  ccStartCleanup :: a -> m a
  ccPushCleanup :: a -> CleanupSetup a s -> m a
  ccGetCleanup :: a -> JumpType -> m (CleanupSetup a s)
  ccExprLookup :: a -> [c] -> MacroName -> m (Expression c)
  ccReserveExprMacro :: a -> [c] -> MacroName -> m a
  ccReleaseExprMacro :: a -> [c] -> MacroName -> m a
  ccSetNoTrace :: a -> Bool -> m a
  ccGetNoTrace :: a -> m Bool

type ExpressionType = Positional ValueType

data MemberValue c =
  MemberValue {
    MemberValue c -> [c]
mvContext :: [c],
    MemberValue c -> VariableName
mvName :: VariableName,
    MemberValue c -> ValueType
mvType :: ValueType
  }
  deriving (Int -> MemberValue c -> ShowS
[MemberValue c] -> ShowS
MemberValue c -> String
(Int -> MemberValue c -> ShowS)
-> (MemberValue c -> String)
-> ([MemberValue c] -> ShowS)
-> Show (MemberValue c)
forall c. Show c => Int -> MemberValue c -> ShowS
forall c. Show c => [MemberValue c] -> ShowS
forall c. Show c => MemberValue c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemberValue c] -> ShowS
$cshowList :: forall c. Show c => [MemberValue c] -> ShowS
show :: MemberValue c -> String
$cshow :: forall c. Show c => MemberValue c -> String
showsPrec :: Int -> MemberValue c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> MemberValue c -> ShowS
Show)

data ReturnVariable =
  ReturnVariable {
    ReturnVariable -> Int
rvIndex :: Int,
    ReturnVariable -> VariableName
rvName :: VariableName,
    ReturnVariable -> ValueType
rvType :: ValueType
  }
  deriving (Int -> ReturnVariable -> ShowS
[ReturnVariable] -> ShowS
ReturnVariable -> String
(Int -> ReturnVariable -> ShowS)
-> (ReturnVariable -> String)
-> ([ReturnVariable] -> ShowS)
-> Show ReturnVariable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnVariable] -> ShowS
$cshowList :: [ReturnVariable] -> ShowS
show :: ReturnVariable -> String
$cshow :: ReturnVariable -> String
showsPrec :: Int -> ReturnVariable -> ShowS
$cshowsPrec :: Int -> ReturnVariable -> ShowS
Show)

data LoopSetup s =
  LoopSetup {
    LoopSetup s -> s
lsUpdate :: s
  } |
  NotInLoop

data CleanupSetup a s =
  CleanupSetup {
    CleanupSetup a s -> [a]
csReturnContext :: [a],
    CleanupSetup a s -> s
csCleanup :: s
  } |
  LoopBoundary

isLoopBoundary :: CleanupSetup a s -> Bool
isLoopBoundary :: CleanupSetup a s -> Bool
isLoopBoundary CleanupSetup a s
LoopBoundary = Bool
True
isLoopBoundary CleanupSetup a s
_            = Bool
False

data JumpType =
  NextStatement |
  JumpContinue |
  JumpBreak |
  JumpReturn |
  JumpFailCall |
  JumpMax  -- Max value for use as initial state in folds.
  deriving (JumpType -> JumpType -> Bool
(JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool) -> Eq JumpType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JumpType -> JumpType -> Bool
$c/= :: JumpType -> JumpType -> Bool
== :: JumpType -> JumpType -> Bool
$c== :: JumpType -> JumpType -> Bool
Eq,Eq JumpType
Eq JumpType
-> (JumpType -> JumpType -> Ordering)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> Bool)
-> (JumpType -> JumpType -> JumpType)
-> (JumpType -> JumpType -> JumpType)
-> Ord JumpType
JumpType -> JumpType -> Bool
JumpType -> JumpType -> Ordering
JumpType -> JumpType -> JumpType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JumpType -> JumpType -> JumpType
$cmin :: JumpType -> JumpType -> JumpType
max :: JumpType -> JumpType -> JumpType
$cmax :: JumpType -> JumpType -> JumpType
>= :: JumpType -> JumpType -> Bool
$c>= :: JumpType -> JumpType -> Bool
> :: JumpType -> JumpType -> Bool
$c> :: JumpType -> JumpType -> Bool
<= :: JumpType -> JumpType -> Bool
$c<= :: JumpType -> JumpType -> Bool
< :: JumpType -> JumpType -> Bool
$c< :: JumpType -> JumpType -> Bool
compare :: JumpType -> JumpType -> Ordering
$ccompare :: JumpType -> JumpType -> Ordering
$cp1Ord :: Eq JumpType
Ord,Int -> JumpType -> ShowS
[JumpType] -> ShowS
JumpType -> String
(Int -> JumpType -> ShowS)
-> (JumpType -> String) -> ([JumpType] -> ShowS) -> Show JumpType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JumpType] -> ShowS
$cshowList :: [JumpType] -> ShowS
show :: JumpType -> String
$cshow :: JumpType -> String
showsPrec :: Int -> JumpType -> ShowS
$cshowsPrec :: Int -> JumpType -> ShowS
Show)

instance Show c => Show (VariableValue c) where
  show :: VariableValue c -> String
show (VariableValue [c]
c SymbolScope
_ ValueType
t Bool
_) = 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

(<???) :: CompileErrorM m => CompilerState a m b -> String -> CompilerState a m b
<??? :: CompilerState a m b -> String -> CompilerState a m b
(<???) CompilerState a m b
x String
s = (m (b, a) -> m (b, a))
-> CompilerState a m b -> CompilerState a m b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (m (b, a) -> String -> m (b, a)
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<?? String
s) CompilerState a m b
x
infixl 1 <???

(???>) :: CompileErrorM m => String -> CompilerState a m b -> CompilerState a m b
???> :: String -> CompilerState a m b -> CompilerState a m b
(???>) String
s CompilerState a m b
x = (m (b, a) -> m (b, a))
-> CompilerState a m b -> CompilerState a m b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (String
s String -> m (b, a) -> m (b, a)
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
??>) CompilerState a m b
x
infixr 1 ???>

(<!!!) :: CompileErrorM m => CompilerState a m b -> String -> CompilerState a m b
<!!! :: CompilerState a m b -> String -> CompilerState a m b
(<!!!) CompilerState a m b
x String
s = (m (b, a) -> m (b, a))
-> CompilerState a m b -> CompilerState a m b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (m (b, a) -> String -> m (b, a)
forall (m :: * -> *) a. CompileErrorM m => m a -> String -> m a
<!! String
s) CompilerState a m b
x
infixl 1 <!!!

(!!!>) :: CompileErrorM m => String -> CompilerState a m b -> CompilerState a m b
!!!> :: String -> CompilerState a m b -> CompilerState a m b
(!!!>) String
s CompilerState a m b
x = (m (b, a) -> m (b, a))
-> CompilerState a m b -> CompilerState a m b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (String
s String -> m (b, a) -> m (b, a)
forall (m :: * -> *) a. CompileErrorM m => String -> m a -> m a
!!>) CompilerState a m b
x
infixr 1 !!!>

resetBackgroundStateT :: CompileErrorM m => CompilerState a m b -> CompilerState a m b
resetBackgroundStateT :: CompilerState a m b -> CompilerState a m b
resetBackgroundStateT CompilerState a m b
x = (m (b, a) -> m (b, a))
-> CompilerState a m b -> CompilerState a m b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (b, a) -> m (b, a)
forall (m :: * -> *) a. CompileErrorM m => m a -> m a
resetBackgroundM CompilerState a m b
x

csCurrentScope :: CompilerContext c m s a => CompilerState a m SymbolScope
csCurrentScope :: CompilerState a m SymbolScope
csCurrentScope = (a -> m SymbolScope) -> StateT a m a -> StateT a m (m SymbolScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m SymbolScope
ccCurrentScope StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m SymbolScope)
-> (m SymbolScope -> CompilerState a m SymbolScope)
-> CompilerState a m SymbolScope
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m SymbolScope -> CompilerState a m SymbolScope
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csResolver :: CompilerContext c m s a => CompilerState a m AnyTypeResolver
csResolver :: CompilerState a m AnyTypeResolver
csResolver = (a -> m AnyTypeResolver)
-> StateT a m a -> StateT a m (m AnyTypeResolver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m AnyTypeResolver
ccResolver StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m AnyTypeResolver)
-> (m AnyTypeResolver -> CompilerState a m AnyTypeResolver)
-> CompilerState a m AnyTypeResolver
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m AnyTypeResolver -> CompilerState a m AnyTypeResolver
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csSameType :: CompilerContext c m s a => TypeInstance -> CompilerState a m Bool
csSameType :: TypeInstance -> CompilerState a m Bool
csSameType TypeInstance
t = (a -> m Bool) -> StateT a m a -> StateT a m (m Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> TypeInstance -> m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> TypeInstance -> m Bool
ccSameType a
x TypeInstance
t) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m Bool)
-> (m Bool -> CompilerState a m Bool) -> CompilerState a m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Bool -> CompilerState a m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csAllFilters :: CompilerContext c m s a => CompilerState a m ParamFilters
csAllFilters :: CompilerState a m ParamFilters
csAllFilters = (a -> m ParamFilters)
-> StateT a m a -> StateT a m (m ParamFilters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m ParamFilters
ccAllFilters StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m ParamFilters)
-> (m ParamFilters -> CompilerState a m ParamFilters)
-> CompilerState a m ParamFilters
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m ParamFilters -> CompilerState a m ParamFilters
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csGetParamScope :: CompilerContext c m s a => ParamName -> CompilerState a m SymbolScope
csGetParamScope :: ParamName -> CompilerState a m SymbolScope
csGetParamScope ParamName
n = (a -> m SymbolScope) -> StateT a m a -> StateT a m (m SymbolScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> ParamName -> m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> ParamName -> m SymbolScope
ccGetParamScope a
x ParamName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m SymbolScope)
-> (m SymbolScope -> CompilerState a m SymbolScope)
-> CompilerState a m SymbolScope
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m SymbolScope -> CompilerState a m SymbolScope
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csRequiresTypes :: CompilerContext c m s a => Set.Set CategoryName -> CompilerState a m ()
csRequiresTypes :: Set CategoryName -> CompilerState a m ()
csRequiresTypes Set CategoryName
ns = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> Set CategoryName -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> Set CategoryName -> m a
ccRequiresTypes a
x Set CategoryName
ns) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csGetRequired :: CompilerContext c m s a => CompilerState a m (Set.Set CategoryName)
csGetRequired :: CompilerState a m (Set CategoryName)
csGetRequired = (a -> m (Set CategoryName))
-> StateT a m a -> StateT a m (m (Set CategoryName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m (Set CategoryName)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m (Set CategoryName)
ccGetRequired StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m (Set CategoryName))
-> (m (Set CategoryName) -> CompilerState a m (Set CategoryName))
-> CompilerState a m (Set CategoryName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Set CategoryName) -> CompilerState a m (Set CategoryName)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csGetCategoryFunction :: CompilerContext c m s a =>
  [c] -> Maybe CategoryName -> FunctionName -> CompilerState a m (ScopedFunction c)
csGetCategoryFunction :: [c]
-> Maybe CategoryName
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetCategoryFunction [c]
c Maybe CategoryName
t FunctionName
n = (a -> m (ScopedFunction c))
-> StateT a m a -> StateT a m (m (ScopedFunction c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a
-> [c]
-> Maybe CategoryName
-> FunctionName
-> m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a
-> [c]
-> Maybe CategoryName
-> FunctionName
-> m (ScopedFunction c)
ccGetCategoryFunction a
x [c]
c Maybe CategoryName
t FunctionName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m (ScopedFunction c))
-> (m (ScopedFunction c) -> CompilerState a m (ScopedFunction c))
-> CompilerState a m (ScopedFunction c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (ScopedFunction c) -> CompilerState a m (ScopedFunction c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csGetTypeFunction :: CompilerContext c m s a =>
  [c] -> Maybe GeneralInstance -> FunctionName -> CompilerState a m (ScopedFunction c)
csGetTypeFunction :: [c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetTypeFunction [c]
c Maybe GeneralInstance
t FunctionName
n = (a -> m (ScopedFunction c))
-> StateT a m a -> StateT a m (m (ScopedFunction c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a
-> [c]
-> Maybe GeneralInstance
-> FunctionName
-> m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a
-> [c]
-> Maybe GeneralInstance
-> FunctionName
-> m (ScopedFunction c)
ccGetTypeFunction a
x [c]
c Maybe GeneralInstance
t FunctionName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m (ScopedFunction c))
-> (m (ScopedFunction c) -> CompilerState a m (ScopedFunction c))
-> CompilerState a m (ScopedFunction c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (ScopedFunction c) -> CompilerState a m (ScopedFunction c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csCheckValueInit :: CompilerContext c m s a =>
  [c] -> TypeInstance -> ExpressionType -> Positional GeneralInstance -> CompilerState a m ()
csCheckValueInit :: [c]
-> TypeInstance
-> ExpressionType
-> Positional GeneralInstance
-> CompilerState a m ()
csCheckValueInit [c]
c TypeInstance
t ExpressionType
as Positional GeneralInstance
ps = (a -> m ()) -> StateT a m a -> StateT a m (m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a
-> [c]
-> TypeInstance
-> ExpressionType
-> Positional GeneralInstance
-> m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a
-> [c]
-> TypeInstance
-> ExpressionType
-> Positional GeneralInstance
-> m ()
ccCheckValueInit a
x [c]
c TypeInstance
t ExpressionType
as Positional GeneralInstance
ps) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m ())
-> (m () -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m () -> CompilerState a m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csGetVariable :: CompilerContext c m s a =>
  [c] -> VariableName -> CompilerState a m (VariableValue c)
csGetVariable :: [c] -> VariableName -> CompilerState a m (VariableValue c)
csGetVariable [c]
c VariableName
n = (a -> m (VariableValue c))
-> StateT a m a -> StateT a m (m (VariableValue c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [c] -> VariableName -> m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> VariableName -> m (VariableValue c)
ccGetVariable a
x [c]
c VariableName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m (VariableValue c))
-> (m (VariableValue c) -> CompilerState a m (VariableValue c))
-> CompilerState a m (VariableValue c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (VariableValue c) -> CompilerState a m (VariableValue c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csAddVariable :: CompilerContext c m s a =>
  [c] -> VariableName -> VariableValue c -> CompilerState a m ()
csAddVariable :: [c] -> VariableName -> VariableValue c -> CompilerState a m ()
csAddVariable [c]
c VariableName
n VariableValue c
t = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [c] -> VariableName -> VariableValue c -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> VariableName -> VariableValue c -> m a
ccAddVariable a
x [c]
c VariableName
n VariableValue c
t) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csCheckVariableInit :: CompilerContext c m s a =>
  [c] -> VariableName -> CompilerState a m ()
csCheckVariableInit :: [c] -> VariableName -> CompilerState a m ()
csCheckVariableInit [c]
c VariableName
n = (a -> m ()) -> StateT a m a -> StateT a m (m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [c] -> VariableName -> m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> VariableName -> m ()
ccCheckVariableInit a
x [c]
c VariableName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m ())
-> (m () -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m () -> CompilerState a m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csWrite :: CompilerContext c m s a => s -> CompilerState a m ()
csWrite :: s -> CompilerState a m ()
csWrite s
o = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> s -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> s -> m a
ccWrite a
x s
o) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csClearOutput :: CompilerContext c m s a => CompilerState a m ()
csClearOutput :: CompilerState a m ()
csClearOutput = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> m a
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m a
ccClearOutput a
x) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csGetOutput :: CompilerContext c m s a => CompilerState a m s
csGetOutput :: CompilerState a m s
csGetOutput = (a -> m s) -> StateT a m a -> StateT a m (m s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m s
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m s
ccGetOutput StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m s)
-> (m s -> CompilerState a m s) -> CompilerState a m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m s -> CompilerState a m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csUpdateAssigned :: CompilerContext c m s a => VariableName -> CompilerState a m ()
csUpdateAssigned :: VariableName -> CompilerState a m ()
csUpdateAssigned VariableName
n = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> VariableName -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> VariableName -> m a
ccUpdateAssigned a
x VariableName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csInheritReturns :: CompilerContext c m s a => [a] -> CompilerState a m ()
csInheritReturns :: [a] -> CompilerState a m ()
csInheritReturns [a]
xs = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [a] -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [a] -> m a
ccInheritReturns a
x [a]
xs) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csRegisterReturn :: CompilerContext c m s a =>
  [c] -> Maybe ExpressionType -> CompilerState a m ()
csRegisterReturn :: [c] -> Maybe ExpressionType -> CompilerState a m ()
csRegisterReturn [c]
c Maybe ExpressionType
rs = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [c] -> Maybe ExpressionType -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> Maybe ExpressionType -> m a
ccRegisterReturn a
x [c]
c Maybe ExpressionType
rs) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csPrimNamedReturns :: CompilerContext c m s a => CompilerState a m [ReturnVariable]
csPrimNamedReturns :: CompilerState a m [ReturnVariable]
csPrimNamedReturns = (a -> m [ReturnVariable])
-> StateT a m a -> StateT a m (m [ReturnVariable])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m [ReturnVariable]
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m [ReturnVariable]
ccPrimNamedReturns StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m [ReturnVariable])
-> (m [ReturnVariable] -> CompilerState a m [ReturnVariable])
-> CompilerState a m [ReturnVariable]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m [ReturnVariable] -> CompilerState a m [ReturnVariable]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csIsUnreachable :: CompilerContext c m s a => CompilerState a m Bool
csIsUnreachable :: CompilerState a m Bool
csIsUnreachable = (a -> m Bool) -> StateT a m a -> StateT a m (m Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m Bool
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m Bool
ccIsUnreachable StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m Bool)
-> (m Bool -> CompilerState a m Bool) -> CompilerState a m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Bool -> CompilerState a m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csIsNamedReturns :: CompilerContext c m s a => CompilerState a m Bool
csIsNamedReturns :: CompilerState a m Bool
csIsNamedReturns = (a -> m Bool) -> StateT a m a -> StateT a m (m Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m Bool
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m Bool
ccIsNamedReturns StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m Bool)
-> (m Bool -> CompilerState a m Bool) -> CompilerState a m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Bool -> CompilerState a m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csSetJumpType :: CompilerContext c m s a => JumpType -> CompilerState a m ()
csSetJumpType :: JumpType -> CompilerState a m ()
csSetJumpType JumpType
j = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> JumpType -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> JumpType -> m a
ccSetJumpType a
x JumpType
j) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csStartLoop :: CompilerContext c m s a => LoopSetup s -> CompilerState a m ()
csStartLoop :: LoopSetup s -> CompilerState a m ()
csStartLoop LoopSetup s
l = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> LoopSetup s -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> LoopSetup s -> m a
ccStartLoop a
x LoopSetup s
l) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csStartCleanup :: CompilerContext c m s a => CompilerState a m ()
csStartCleanup :: CompilerState a m ()
csStartCleanup = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> m a
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m a
ccStartCleanup a
x) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csGetLoop :: CompilerContext c m s a => CompilerState a m (LoopSetup s)
csGetLoop :: CompilerState a m (LoopSetup s)
csGetLoop = (a -> m (LoopSetup s))
-> StateT a m a -> StateT a m (m (LoopSetup s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m (LoopSetup s)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m (LoopSetup s)
ccGetLoop StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m (LoopSetup s))
-> (m (LoopSetup s) -> CompilerState a m (LoopSetup s))
-> CompilerState a m (LoopSetup s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (LoopSetup s) -> CompilerState a m (LoopSetup s)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csPushCleanup :: CompilerContext c m s a => CleanupSetup a s -> CompilerState a m ()
csPushCleanup :: CleanupSetup a s -> CompilerState a m ()
csPushCleanup CleanupSetup a s
l = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> CleanupSetup a s -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> CleanupSetup a s -> m a
ccPushCleanup a
x CleanupSetup a s
l) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csGetCleanup :: CompilerContext c m s a => JumpType -> CompilerState a m (CleanupSetup a s)
csGetCleanup :: JumpType -> CompilerState a m (CleanupSetup a s)
csGetCleanup JumpType
j = (a -> m (CleanupSetup a s))
-> StateT a m a -> StateT a m (m (CleanupSetup a s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> JumpType -> m (CleanupSetup a s)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> JumpType -> m (CleanupSetup a s)
ccGetCleanup a
x JumpType
j) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m (CleanupSetup a s))
-> (m (CleanupSetup a s) -> CompilerState a m (CleanupSetup a s))
-> CompilerState a m (CleanupSetup a s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (CleanupSetup a s) -> CompilerState a m (CleanupSetup a s)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csExprLookup :: CompilerContext c m s a => [c] -> MacroName -> CompilerState a m (Expression c)
csExprLookup :: [c] -> MacroName -> CompilerState a m (Expression c)
csExprLookup [c]
c MacroName
n = (a -> m (Expression c))
-> StateT a m a -> StateT a m (m (Expression c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [c] -> MacroName -> m (Expression c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> MacroName -> m (Expression c)
ccExprLookup a
x [c]
c MacroName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m (Expression c))
-> (m (Expression c) -> CompilerState a m (Expression c))
-> CompilerState a m (Expression c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Expression c) -> CompilerState a m (Expression c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

csReserveExprMacro :: CompilerContext c m s a => [c] -> MacroName -> CompilerState a m ()
csReserveExprMacro :: [c] -> MacroName -> CompilerState a m ()
csReserveExprMacro [c]
c MacroName
n = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [c] -> MacroName -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> MacroName -> m a
ccReserveExprMacro a
x [c]
c MacroName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csReleaseExprMacro :: CompilerContext c m s a => [c] -> MacroName -> CompilerState a m ()
csReleaseExprMacro :: [c] -> MacroName -> CompilerState a m ()
csReleaseExprMacro [c]
c MacroName
n = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> [c] -> MacroName -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> MacroName -> m a
ccReleaseExprMacro a
x [c]
c MacroName
n) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csSetNoTrace :: CompilerContext c m s a => Bool -> CompilerState a m ()
csSetNoTrace :: Bool -> CompilerState a m ()
csSetNoTrace Bool
t = (a -> m a) -> StateT a m a -> StateT a m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> Bool -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> Bool -> m a
ccSetNoTrace a
x Bool
t) StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m a) -> (m a -> StateT a m a) -> StateT a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CompilerState a m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

csGetNoTrace :: CompilerContext c m s a => CompilerState a m Bool
csGetNoTrace :: CompilerState a m Bool
csGetNoTrace = (a -> m Bool) -> StateT a m a -> StateT a m (m Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m Bool
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m Bool
ccGetNoTrace StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m (m Bool)
-> (m Bool -> CompilerState a m Bool) -> CompilerState a m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Bool -> CompilerState a m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

data CompiledData s =
  CompiledData {
    CompiledData s -> Set CategoryName
cdRequired :: Set.Set CategoryName,
    CompiledData s -> s
cdOutput :: s
  }

instance Semigroup s => Semigroup (CompiledData s) where
  (CompiledData Set CategoryName
r1 s
s1) <> :: CompiledData s -> CompiledData s -> CompiledData s
<> (CompiledData Set CategoryName
r2 s
s2) =
    Set CategoryName -> s -> CompiledData s
forall s. Set CategoryName -> s -> CompiledData s
CompiledData (Set CategoryName
r1 Set CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CategoryName
r2) (s
s1 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
s2)

instance (Semigroup s, Monoid s) => Monoid (CompiledData s) where
  mempty :: CompiledData s
mempty = Set CategoryName -> s -> CompiledData s
forall s. Set CategoryName -> s -> CompiledData s
CompiledData Set CategoryName
forall a. Set a
Set.empty s
forall a. Monoid a => a
mempty
  mappend :: CompiledData s -> CompiledData s -> CompiledData s
mappend = CompiledData s -> CompiledData s -> CompiledData s
forall a. Semigroup a => a -> a -> a
(<>)

runDataCompiler :: CompilerContext c m s a =>
  CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler :: CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler CompilerState a m b
x a
ctx = do
  a
ctx' <- CompilerState a m b -> a -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT CompilerState a m b
x a
ctx
  Set CategoryName
required <- a -> m (Set CategoryName)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m (Set CategoryName)
ccGetRequired a
ctx'
  s
output <- a -> m s
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m s
ccGetOutput a
ctx'
  CompiledData s -> m (CompiledData s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData s -> m (CompiledData s))
-> CompiledData s -> m (CompiledData s)
forall a b. (a -> b) -> a -> b
$ CompiledData :: forall s. Set CategoryName -> s -> CompiledData s
CompiledData {
      cdRequired :: Set CategoryName
cdRequired = Set CategoryName
required,
      cdOutput :: s
cdOutput = s
output
    }

concatM :: (Semigroup s, Monoid s, CompileErrorM m) => [m (CompiledData s)] -> m (CompiledData s)
concatM :: [m (CompiledData s)] -> m (CompiledData s)
concatM = ([CompiledData s] -> CompiledData s)
-> m [CompiledData s] -> m (CompiledData s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CompiledData s] -> CompiledData s
forall a. Monoid a => [a] -> a
mconcat (m [CompiledData s] -> m (CompiledData s))
-> ([m (CompiledData s)] -> m [CompiledData s])
-> [m (CompiledData s)]
-> m (CompiledData s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m (CompiledData s)] -> m [CompiledData s]
forall (m :: * -> *) (f :: * -> *) a.
(CompileErrorM m, Foldable f) =>
f (m a) -> m [a]
collectAllM

getCleanContext :: CompilerContext c m s a => CompilerState a m a
getCleanContext :: CompilerState a m a
getCleanContext = CompilerState a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get CompilerState a m a
-> (a -> CompilerState a m a) -> CompilerState a m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> CompilerState a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a)
-> (a -> m a) -> a -> CompilerState a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m a
ccClearOutput