{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}
{-# LANGUAGE CPP #-}
module ShellCheck.CFGAnalysis (
analyzeControlFlow
,CFGParameters (..)
,CFGAnalysis (..)
,ProgramState (..)
,VariableState (..)
,VariableValue (..)
,VariableProperties
,SpaceStatus (..)
,NumericalStatus (..)
,getIncomingState
,getOutgoingState
,doesPostDominate
,ShellCheck.CFGAnalysis.runTests
) where
import Control.DeepSeq
import Control.Monad
import Control.Monad.ST
import Data.Array.Unboxed
import Data.Char
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Query.DFS
import Data.List hiding (map)
import Data.Maybe
import Data.STRef
import Debug.Trace
import GHC.Generics (Generic)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified ShellCheck.Data as Data
import ShellCheck.AST
import ShellCheck.CFG
import ShellCheck.Prelude
import Test.QuickCheck
iterationCount :: Integer
iterationCount = Integer
1000000
fallbackThreshold :: Integer
fallbackThreshold = Integer
10000
cacheEntries :: Int
cacheEntries = Int
10
logVerbose :: p -> m ()
logVerbose p
log = do
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logInfo :: p -> m ()
logInfo p
log = do
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data CFGAnalysis = CFGAnalysis {
CFGAnalysis -> CFGraph
graph :: CFGraph,
CFGAnalysis -> Map Id (Int, Int)
tokenToRange :: M.Map Id (Node, Node),
CFGAnalysis -> Map Id (Set Int)
tokenToNodes :: M.Map Id (S.Set Node),
CFGAnalysis -> Array Int [Int]
postDominators :: Array Node [Node],
CFGAnalysis -> Map Int (ProgramState, ProgramState)
nodeToData :: M.Map Node (ProgramState, ProgramState)
} deriving (Int -> CFGAnalysis -> ShowS
[CFGAnalysis] -> ShowS
CFGAnalysis -> String
(Int -> CFGAnalysis -> ShowS)
-> (CFGAnalysis -> String)
-> ([CFGAnalysis] -> ShowS)
-> Show CFGAnalysis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFGAnalysis] -> ShowS
$cshowList :: [CFGAnalysis] -> ShowS
show :: CFGAnalysis -> String
$cshow :: CFGAnalysis -> String
showsPrec :: Int -> CFGAnalysis -> ShowS
$cshowsPrec :: Int -> CFGAnalysis -> ShowS
Show)
data ProgramState = ProgramState {
ProgramState -> Map String VariableState
variablesInScope :: M.Map String VariableState,
ProgramState -> Set Id
exitCodes :: S.Set Id,
ProgramState -> Bool
stateIsReachable :: Bool
} deriving (Int -> ProgramState -> ShowS
[ProgramState] -> ShowS
ProgramState -> String
(Int -> ProgramState -> ShowS)
-> (ProgramState -> String)
-> ([ProgramState] -> ShowS)
-> Show ProgramState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProgramState] -> ShowS
$cshowList :: [ProgramState] -> ShowS
show :: ProgramState -> String
$cshow :: ProgramState -> String
showsPrec :: Int -> ProgramState -> ShowS
$cshowsPrec :: Int -> ProgramState -> ShowS
Show, ProgramState -> ProgramState -> Bool
(ProgramState -> ProgramState -> Bool)
-> (ProgramState -> ProgramState -> Bool) -> Eq ProgramState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProgramState -> ProgramState -> Bool
$c/= :: ProgramState -> ProgramState -> Bool
== :: ProgramState -> ProgramState -> Bool
$c== :: ProgramState -> ProgramState -> Bool
Eq, (forall x. ProgramState -> Rep ProgramState x)
-> (forall x. Rep ProgramState x -> ProgramState)
-> Generic ProgramState
forall x. Rep ProgramState x -> ProgramState
forall x. ProgramState -> Rep ProgramState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProgramState x -> ProgramState
$cfrom :: forall x. ProgramState -> Rep ProgramState x
Generic, ProgramState -> ()
(ProgramState -> ()) -> NFData ProgramState
forall a. (a -> ()) -> NFData a
rnf :: ProgramState -> ()
$crnf :: ProgramState -> ()
NFData)
internalToExternal :: InternalState -> ProgramState
internalToExternal :: InternalState -> ProgramState
internalToExternal InternalState
s =
ProgramState :: Map String VariableState -> Set Id -> Bool -> ProgramState
ProgramState {
variablesInScope :: Map String VariableState
variablesInScope = (VariableState -> VariableState)
-> Map String VariableState -> Map String VariableState
forall a b k. (a -> b) -> Map k a -> Map k b
M.map VariableState -> VariableState
censor Map String VariableState
flatVars,
exitCodes :: Set Id
exitCodes = Set Id -> Maybe (Set Id) -> Set Id
forall a. a -> Maybe a -> a
fromMaybe Set Id
forall a. Set a
S.empty (Maybe (Set Id) -> Set Id) -> Maybe (Set Id) -> Set Id
forall a b. (a -> b) -> a -> b
$ InternalState -> Maybe (Set Id)
sExitCodes InternalState
s,
stateIsReachable :: Bool
stateIsReachable = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ InternalState -> Maybe Bool
sIsReachable InternalState
s
}
where
censor :: VariableState -> VariableState
censor VariableState
s = VariableState
s {
variableValue :: VariableValue
variableValue = (VariableState -> VariableValue
variableValue VariableState
s) {
literalValue :: Maybe String
literalValue = Maybe String
forall a. Maybe a
Nothing
}
}
flatVars :: Map String VariableState
flatVars = (VariableState -> VariableState -> VariableState)
-> [Map String VariableState] -> Map String VariableState
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith (\VariableState
_ VariableState
last -> VariableState
last) ([Map String VariableState] -> Map String VariableState)
-> [Map String VariableState] -> Map String VariableState
forall a b. (a -> b) -> a -> b
$ (VersionedMap String VariableState -> Map String VariableState)
-> [VersionedMap String VariableState]
-> [Map String VariableState]
forall a b. (a -> b) -> [a] -> [b]
map VersionedMap String VariableState -> Map String VariableState
forall k v. VersionedMap k v -> Map k v
mapStorage [InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
s, InternalState -> VersionedMap String VariableState
sLocalValues InternalState
s, InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
s]
getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState
getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState
getIncomingState CFGAnalysis
analysis Id
id = do
(Int
start,Int
end) <- Id -> Map Id (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
id (Map Id (Int, Int) -> Maybe (Int, Int))
-> Map Id (Int, Int) -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Int, Int)
tokenToRange CFGAnalysis
analysis
(ProgramState, ProgramState) -> ProgramState
forall a b. (a, b) -> a
fst ((ProgramState, ProgramState) -> ProgramState)
-> Maybe (ProgramState, ProgramState) -> Maybe ProgramState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Map Int (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
start (CFGAnalysis -> Map Int (ProgramState, ProgramState)
nodeToData CFGAnalysis
analysis)
getOutgoingState :: CFGAnalysis -> Id -> Maybe ProgramState
getOutgoingState :: CFGAnalysis -> Id -> Maybe ProgramState
getOutgoingState CFGAnalysis
analysis Id
id = do
(Int
start,Int
end) <- Id -> Map Id (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
id (Map Id (Int, Int) -> Maybe (Int, Int))
-> Map Id (Int, Int) -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Int, Int)
tokenToRange CFGAnalysis
analysis
(ProgramState, ProgramState) -> ProgramState
forall a b. (a, b) -> b
snd ((ProgramState, ProgramState) -> ProgramState)
-> Maybe (ProgramState, ProgramState) -> Maybe ProgramState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Map Int (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
end (CFGAnalysis -> Map Int (ProgramState, ProgramState)
nodeToData CFGAnalysis
analysis)
doesPostDominate :: CFGAnalysis -> Id -> Id -> Bool
doesPostDominate :: CFGAnalysis -> Id -> Id -> Bool
doesPostDominate CFGAnalysis
analysis Id
target Id
base = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
(Int
_, Int
baseEnd) <- Id -> Map Id (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
base (Map Id (Int, Int) -> Maybe (Int, Int))
-> Map Id (Int, Int) -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Int, Int)
tokenToRange CFGAnalysis
analysis
(Int
targetStart, Int
_) <- Id -> Map Id (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
target (Map Id (Int, Int) -> Maybe (Int, Int))
-> Map Id (Int, Int) -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Int, Int)
tokenToRange CFGAnalysis
analysis
Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Int
targetStart Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CFGAnalysis -> Array Int [Int]
postDominators CFGAnalysis
analysis Array Int [Int] -> Int -> [Int]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
baseEnd)
getDataForNode :: CFGAnalysis -> Int -> Maybe (ProgramState, ProgramState)
getDataForNode CFGAnalysis
analysis Int
node = Int
-> Map Int (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
node (Map Int (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState))
-> Map Int (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Int (ProgramState, ProgramState)
nodeToData CFGAnalysis
analysis
data InternalState = InternalState {
InternalState -> Integer
sVersion :: Integer,
InternalState -> VersionedMap String VariableState
sGlobalValues :: VersionedMap String VariableState,
InternalState -> VersionedMap String VariableState
sLocalValues :: VersionedMap String VariableState,
InternalState -> VersionedMap String VariableState
sPrefixValues :: VersionedMap String VariableState,
InternalState -> VersionedMap String FunctionValue
sFunctionTargets :: VersionedMap String FunctionValue,
InternalState -> Maybe (Set Id)
sExitCodes :: Maybe (S.Set Id),
InternalState -> Maybe Bool
sIsReachable :: Maybe Bool
} deriving (Int -> InternalState -> ShowS
[InternalState] -> ShowS
InternalState -> String
(Int -> InternalState -> ShowS)
-> (InternalState -> String)
-> ([InternalState] -> ShowS)
-> Show InternalState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalState] -> ShowS
$cshowList :: [InternalState] -> ShowS
show :: InternalState -> String
$cshow :: InternalState -> String
showsPrec :: Int -> InternalState -> ShowS
$cshowsPrec :: Int -> InternalState -> ShowS
Show, (forall x. InternalState -> Rep InternalState x)
-> (forall x. Rep InternalState x -> InternalState)
-> Generic InternalState
forall x. Rep InternalState x -> InternalState
forall x. InternalState -> Rep InternalState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InternalState x -> InternalState
$cfrom :: forall x. InternalState -> Rep InternalState x
Generic, InternalState -> ()
(InternalState -> ()) -> NFData InternalState
forall a. (a -> ()) -> NFData a
rnf :: InternalState -> ()
$crnf :: InternalState -> ()
NFData)
newInternalState :: InternalState
newInternalState = InternalState :: Integer
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String FunctionValue
-> Maybe (Set Id)
-> Maybe Bool
-> InternalState
InternalState {
sVersion :: Integer
sVersion = Integer
0,
sGlobalValues :: VersionedMap String VariableState
sGlobalValues = VersionedMap String VariableState
forall k v. VersionedMap k v
vmEmpty,
sLocalValues :: VersionedMap String VariableState
sLocalValues = VersionedMap String VariableState
forall k v. VersionedMap k v
vmEmpty,
sPrefixValues :: VersionedMap String VariableState
sPrefixValues = VersionedMap String VariableState
forall k v. VersionedMap k v
vmEmpty,
sFunctionTargets :: VersionedMap String FunctionValue
sFunctionTargets = VersionedMap String FunctionValue
forall k v. VersionedMap k v
vmEmpty,
sExitCodes :: Maybe (Set Id)
sExitCodes = Maybe (Set Id)
forall a. Maybe a
Nothing,
sIsReachable :: Maybe Bool
sIsReachable = Maybe Bool
forall a. Maybe a
Nothing
}
unreachableState :: InternalState
unreachableState = InternalState -> InternalState
modified InternalState
newInternalState {
sIsReachable :: Maybe Bool
sIsReachable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
}
createEnvironmentState :: InternalState
createEnvironmentState :: InternalState
createEnvironmentState = do
(InternalState
-> (InternalState -> InternalState) -> InternalState)
-> InternalState
-> [InternalState -> InternalState]
-> InternalState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((InternalState -> InternalState)
-> InternalState -> InternalState)
-> InternalState
-> (InternalState -> InternalState)
-> InternalState
forall a b c. (a -> b -> c) -> b -> a -> c
flip (InternalState -> InternalState) -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
($)) InternalState
newInternalState ([InternalState -> InternalState] -> InternalState)
-> [InternalState -> InternalState] -> InternalState
forall a b. (a -> b) -> a -> b
$ [[InternalState -> InternalState]]
-> [InternalState -> InternalState]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[String] -> VariableState -> [InternalState -> InternalState]
addVars [String]
Data.internalVariables VariableState
unknownVariableState,
[String] -> VariableState -> [InternalState -> InternalState]
addVars [String]
Data.variablesWithoutSpaces VariableState
spacelessVariableState,
[String] -> VariableState -> [InternalState -> InternalState]
addVars [String]
Data.specialIntegerVariables VariableState
integerVariableState
]
where
addVars :: [String] -> VariableState -> [InternalState -> InternalState]
addVars [String]
names VariableState
val = (String -> InternalState -> InternalState)
-> [String] -> [InternalState -> InternalState]
forall a b. (a -> b) -> [a] -> [b]
map (\String
name -> String -> VariableState -> InternalState -> InternalState
insertGlobal String
name VariableState
val) [String]
names
spacelessVariableState :: VariableState
spacelessVariableState = VariableState
unknownVariableState {
variableValue :: VariableValue
variableValue = VariableValue :: Maybe String -> SpaceStatus -> NumericalStatus -> VariableValue
VariableValue {
literalValue :: Maybe String
literalValue = Maybe String
forall a. Maybe a
Nothing,
spaceStatus :: SpaceStatus
spaceStatus = SpaceStatus
SpaceStatusClean,
numericalStatus :: NumericalStatus
numericalStatus = NumericalStatus
NumericalStatusUnknown
}
}
integerVariableState :: VariableState
integerVariableState = VariableState
unknownVariableState {
variableValue :: VariableValue
variableValue = VariableValue
unknownIntegerValue
}
modified :: InternalState -> InternalState
modified InternalState
s = InternalState
s { sVersion :: Integer
sVersion = -Integer
1 }
insertGlobal :: String -> VariableState -> InternalState -> InternalState
insertGlobal :: String -> VariableState -> InternalState -> InternalState
insertGlobal String
name VariableState
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
sGlobalValues :: VersionedMap String VariableState
sGlobalValues = String
-> VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall k v. Ord k => k -> v -> VersionedMap k v -> VersionedMap k v
vmInsert String
name VariableState
value (VersionedMap String VariableState
-> VersionedMap String VariableState)
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
state
}
insertLocal :: String -> VariableState -> InternalState -> InternalState
insertLocal :: String -> VariableState -> InternalState -> InternalState
insertLocal String
name VariableState
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
sLocalValues :: VersionedMap String VariableState
sLocalValues = String
-> VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall k v. Ord k => k -> v -> VersionedMap k v -> VersionedMap k v
vmInsert String
name VariableState
value (VersionedMap String VariableState
-> VersionedMap String VariableState)
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sLocalValues InternalState
state
}
insertPrefix :: String -> VariableState -> InternalState -> InternalState
insertPrefix :: String -> VariableState -> InternalState -> InternalState
insertPrefix String
name VariableState
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
sPrefixValues :: VersionedMap String VariableState
sPrefixValues = String
-> VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall k v. Ord k => k -> v -> VersionedMap k v -> VersionedMap k v
vmInsert String
name VariableState
value (VersionedMap String VariableState
-> VersionedMap String VariableState)
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
state
}
insertFunction :: String -> FunctionValue -> InternalState -> InternalState
insertFunction :: String -> FunctionValue -> InternalState -> InternalState
insertFunction String
name FunctionValue
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
sFunctionTargets :: VersionedMap String FunctionValue
sFunctionTargets = String
-> FunctionValue
-> VersionedMap String FunctionValue
-> VersionedMap String FunctionValue
forall k v. Ord k => k -> v -> VersionedMap k v -> VersionedMap k v
vmInsert String
name FunctionValue
value (VersionedMap String FunctionValue
-> VersionedMap String FunctionValue)
-> VersionedMap String FunctionValue
-> VersionedMap String FunctionValue
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
state
}
addProperties :: S.Set CFVariableProp -> VariableState -> VariableState
addProperties :: Set CFVariableProp -> VariableState -> VariableState
addProperties Set CFVariableProp
props VariableState
state = VariableState
state {
variableProperties :: VariableProperties
variableProperties = (Set CFVariableProp -> Set CFVariableProp)
-> VariableProperties -> VariableProperties
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (Set CFVariableProp -> Set CFVariableProp -> Set CFVariableProp
forall a. Ord a => Set a -> Set a -> Set a
S.union Set CFVariableProp
props) (VariableProperties -> VariableProperties)
-> VariableProperties -> VariableProperties
forall a b. (a -> b) -> a -> b
$ VariableState -> VariableProperties
variableProperties VariableState
state
}
removeProperties :: S.Set CFVariableProp -> VariableState -> VariableState
removeProperties :: Set CFVariableProp -> VariableState -> VariableState
removeProperties Set CFVariableProp
props VariableState
state = VariableState
state {
variableProperties :: VariableProperties
variableProperties = (Set CFVariableProp -> Set CFVariableProp)
-> VariableProperties -> VariableProperties
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\Set CFVariableProp
s -> Set CFVariableProp -> Set CFVariableProp -> Set CFVariableProp
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set CFVariableProp
s Set CFVariableProp
props) (VariableProperties -> VariableProperties)
-> VariableProperties -> VariableProperties
forall a b. (a -> b) -> a -> b
$ VariableState -> VariableProperties
variableProperties VariableState
state
}
setExitCode :: Id -> InternalState -> InternalState
setExitCode Id
id = Set Id -> InternalState -> InternalState
setExitCodes (Id -> Set Id
forall a. a -> Set a
S.singleton Id
id)
setExitCodes :: Set Id -> InternalState -> InternalState
setExitCodes Set Id
set InternalState
state = InternalState -> InternalState
modified InternalState
state {
sExitCodes :: Maybe (Set Id)
sExitCodes = Set Id -> Maybe (Set Id)
forall a. a -> Maybe a
Just (Set Id -> Maybe (Set Id)) -> Set Id -> Maybe (Set Id)
forall a b. (a -> b) -> a -> b
$ Set Id
set
}
data StateDependency =
DepState Scope String VariableState
| DepProperties Scope String VariableProperties
| DepFunction String (S.Set FunctionDefinition)
| DepIsRecursive Node Bool
| DepExitCodes (S.Set Id)
deriving (Int -> StateDependency -> ShowS
[StateDependency] -> ShowS
StateDependency -> String
(Int -> StateDependency -> ShowS)
-> (StateDependency -> String)
-> ([StateDependency] -> ShowS)
-> Show StateDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateDependency] -> ShowS
$cshowList :: [StateDependency] -> ShowS
show :: StateDependency -> String
$cshow :: StateDependency -> String
showsPrec :: Int -> StateDependency -> ShowS
$cshowsPrec :: Int -> StateDependency -> ShowS
Show, StateDependency -> StateDependency -> Bool
(StateDependency -> StateDependency -> Bool)
-> (StateDependency -> StateDependency -> Bool)
-> Eq StateDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateDependency -> StateDependency -> Bool
$c/= :: StateDependency -> StateDependency -> Bool
== :: StateDependency -> StateDependency -> Bool
$c== :: StateDependency -> StateDependency -> Bool
Eq, Eq StateDependency
Eq StateDependency
-> (StateDependency -> StateDependency -> Ordering)
-> (StateDependency -> StateDependency -> Bool)
-> (StateDependency -> StateDependency -> Bool)
-> (StateDependency -> StateDependency -> Bool)
-> (StateDependency -> StateDependency -> Bool)
-> (StateDependency -> StateDependency -> StateDependency)
-> (StateDependency -> StateDependency -> StateDependency)
-> Ord StateDependency
StateDependency -> StateDependency -> Bool
StateDependency -> StateDependency -> Ordering
StateDependency -> StateDependency -> StateDependency
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 :: StateDependency -> StateDependency -> StateDependency
$cmin :: StateDependency -> StateDependency -> StateDependency
max :: StateDependency -> StateDependency -> StateDependency
$cmax :: StateDependency -> StateDependency -> StateDependency
>= :: StateDependency -> StateDependency -> Bool
$c>= :: StateDependency -> StateDependency -> Bool
> :: StateDependency -> StateDependency -> Bool
$c> :: StateDependency -> StateDependency -> Bool
<= :: StateDependency -> StateDependency -> Bool
$c<= :: StateDependency -> StateDependency -> Bool
< :: StateDependency -> StateDependency -> Bool
$c< :: StateDependency -> StateDependency -> Bool
compare :: StateDependency -> StateDependency -> Ordering
$ccompare :: StateDependency -> StateDependency -> Ordering
$cp1Ord :: Eq StateDependency
Ord, (forall x. StateDependency -> Rep StateDependency x)
-> (forall x. Rep StateDependency x -> StateDependency)
-> Generic StateDependency
forall x. Rep StateDependency x -> StateDependency
forall x. StateDependency -> Rep StateDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StateDependency x -> StateDependency
$cfrom :: forall x. StateDependency -> Rep StateDependency x
Generic, StateDependency -> ()
(StateDependency -> ()) -> NFData StateDependency
forall a. (a -> ()) -> NFData a
rnf :: StateDependency -> ()
$crnf :: StateDependency -> ()
NFData)
data FunctionDefinition = FunctionUnknown | FunctionDefinition String Node Node
deriving (Int -> FunctionDefinition -> ShowS
[FunctionDefinition] -> ShowS
FunctionDefinition -> String
(Int -> FunctionDefinition -> ShowS)
-> (FunctionDefinition -> String)
-> ([FunctionDefinition] -> ShowS)
-> Show FunctionDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionDefinition] -> ShowS
$cshowList :: [FunctionDefinition] -> ShowS
show :: FunctionDefinition -> String
$cshow :: FunctionDefinition -> String
showsPrec :: Int -> FunctionDefinition -> ShowS
$cshowsPrec :: Int -> FunctionDefinition -> ShowS
Show, FunctionDefinition -> FunctionDefinition -> Bool
(FunctionDefinition -> FunctionDefinition -> Bool)
-> (FunctionDefinition -> FunctionDefinition -> Bool)
-> Eq FunctionDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionDefinition -> FunctionDefinition -> Bool
$c/= :: FunctionDefinition -> FunctionDefinition -> Bool
== :: FunctionDefinition -> FunctionDefinition -> Bool
$c== :: FunctionDefinition -> FunctionDefinition -> Bool
Eq, Eq FunctionDefinition
Eq FunctionDefinition
-> (FunctionDefinition -> FunctionDefinition -> Ordering)
-> (FunctionDefinition -> FunctionDefinition -> Bool)
-> (FunctionDefinition -> FunctionDefinition -> Bool)
-> (FunctionDefinition -> FunctionDefinition -> Bool)
-> (FunctionDefinition -> FunctionDefinition -> Bool)
-> (FunctionDefinition -> FunctionDefinition -> FunctionDefinition)
-> (FunctionDefinition -> FunctionDefinition -> FunctionDefinition)
-> Ord FunctionDefinition
FunctionDefinition -> FunctionDefinition -> Bool
FunctionDefinition -> FunctionDefinition -> Ordering
FunctionDefinition -> FunctionDefinition -> FunctionDefinition
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 :: FunctionDefinition -> FunctionDefinition -> FunctionDefinition
$cmin :: FunctionDefinition -> FunctionDefinition -> FunctionDefinition
max :: FunctionDefinition -> FunctionDefinition -> FunctionDefinition
$cmax :: FunctionDefinition -> FunctionDefinition -> FunctionDefinition
>= :: FunctionDefinition -> FunctionDefinition -> Bool
$c>= :: FunctionDefinition -> FunctionDefinition -> Bool
> :: FunctionDefinition -> FunctionDefinition -> Bool
$c> :: FunctionDefinition -> FunctionDefinition -> Bool
<= :: FunctionDefinition -> FunctionDefinition -> Bool
$c<= :: FunctionDefinition -> FunctionDefinition -> Bool
< :: FunctionDefinition -> FunctionDefinition -> Bool
$c< :: FunctionDefinition -> FunctionDefinition -> Bool
compare :: FunctionDefinition -> FunctionDefinition -> Ordering
$ccompare :: FunctionDefinition -> FunctionDefinition -> Ordering
$cp1Ord :: Eq FunctionDefinition
Ord, (forall x. FunctionDefinition -> Rep FunctionDefinition x)
-> (forall x. Rep FunctionDefinition x -> FunctionDefinition)
-> Generic FunctionDefinition
forall x. Rep FunctionDefinition x -> FunctionDefinition
forall x. FunctionDefinition -> Rep FunctionDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionDefinition x -> FunctionDefinition
$cfrom :: forall x. FunctionDefinition -> Rep FunctionDefinition x
Generic, FunctionDefinition -> ()
(FunctionDefinition -> ()) -> NFData FunctionDefinition
forall a. (a -> ()) -> NFData a
rnf :: FunctionDefinition -> ()
$crnf :: FunctionDefinition -> ()
NFData)
type FunctionValue = S.Set FunctionDefinition
depsToState :: S.Set StateDependency -> InternalState
depsToState :: Set StateDependency -> InternalState
depsToState Set StateDependency
set = (InternalState -> StateDependency -> InternalState)
-> InternalState -> [StateDependency] -> InternalState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl InternalState -> StateDependency -> InternalState
insert InternalState
newInternalState ([StateDependency] -> InternalState)
-> [StateDependency] -> InternalState
forall a b. (a -> b) -> a -> b
$ Set StateDependency -> [StateDependency]
forall a. Set a -> [a]
S.toList Set StateDependency
set
where
insert :: InternalState -> StateDependency -> InternalState
insert :: InternalState -> StateDependency -> InternalState
insert InternalState
state StateDependency
dep =
case StateDependency
dep of
DepFunction String
name FunctionValue
val -> String -> FunctionValue -> InternalState -> InternalState
insertFunction String
name FunctionValue
val InternalState
state
DepState Scope
scope String
name VariableState
val -> Bool
-> Scope
-> String
-> VariableState
-> InternalState
-> InternalState
insertIn Bool
True Scope
scope String
name VariableState
val InternalState
state
DepProperties Scope
scope String
name VariableProperties
props -> Bool
-> Scope
-> String
-> VariableState
-> InternalState
-> InternalState
insertIn Bool
False Scope
scope String
name VariableState
unknownVariableState { variableProperties :: VariableProperties
variableProperties = VariableProperties
props } InternalState
state
DepIsRecursive Int
_ Bool
_ -> InternalState
state
DepExitCodes Set Id
s -> Set Id -> InternalState -> InternalState
setExitCodes Set Id
s InternalState
state
insertIn :: Bool
-> Scope
-> String
-> VariableState
-> InternalState
-> InternalState
insertIn Bool
overwrite Scope
scope String
name VariableState
val InternalState
state =
let
(InternalState -> VersionedMap String VariableState
mapToCheck, String -> VariableState -> InternalState -> InternalState
inserter) =
case Scope
scope of
Scope
PrefixScope -> (InternalState -> VersionedMap String VariableState
sPrefixValues, String -> VariableState -> InternalState -> InternalState
insertPrefix)
Scope
LocalScope -> (InternalState -> VersionedMap String VariableState
sLocalValues, String -> VariableState -> InternalState -> InternalState
insertLocal)
Scope
GlobalScope -> (InternalState -> VersionedMap String VariableState
sGlobalValues, String -> VariableState -> InternalState -> InternalState
insertGlobal)
Scope
DefaultScope -> String
-> (InternalState -> VersionedMap String VariableState,
String -> VariableState -> InternalState -> InternalState)
forall a. HasCallStack => String -> a
error (String
-> (InternalState -> VersionedMap String VariableState,
String -> VariableState -> InternalState -> InternalState))
-> String
-> (InternalState -> VersionedMap String VariableState,
String -> VariableState -> InternalState -> InternalState)
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Unresolved scope in dependency"
alreadyExists :: Bool
alreadyExists = Maybe VariableState -> Bool
forall a. Maybe a -> Bool
isJust (Maybe VariableState -> Bool) -> Maybe VariableState -> Bool
forall a b. (a -> b) -> a -> b
$ String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
mapToCheck InternalState
state
in
if Bool
overwrite Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
alreadyExists
then String -> VariableState -> InternalState -> InternalState
inserter String
name VariableState
val InternalState
state
else InternalState
state
unknownFunctionValue :: FunctionValue
unknownFunctionValue = FunctionDefinition -> FunctionValue
forall a. a -> Set a
S.singleton FunctionDefinition
FunctionUnknown
data VariableValue = VariableValue {
VariableValue -> Maybe String
literalValue :: Maybe String,
VariableValue -> SpaceStatus
spaceStatus :: SpaceStatus,
VariableValue -> NumericalStatus
numericalStatus :: NumericalStatus
}
deriving (Int -> VariableValue -> ShowS
[VariableValue] -> ShowS
VariableValue -> String
(Int -> VariableValue -> ShowS)
-> (VariableValue -> String)
-> ([VariableValue] -> ShowS)
-> Show VariableValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariableValue] -> ShowS
$cshowList :: [VariableValue] -> ShowS
show :: VariableValue -> String
$cshow :: VariableValue -> String
showsPrec :: Int -> VariableValue -> ShowS
$cshowsPrec :: Int -> VariableValue -> ShowS
Show, VariableValue -> VariableValue -> Bool
(VariableValue -> VariableValue -> Bool)
-> (VariableValue -> VariableValue -> Bool) -> Eq VariableValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariableValue -> VariableValue -> Bool
$c/= :: VariableValue -> VariableValue -> Bool
== :: VariableValue -> VariableValue -> Bool
$c== :: VariableValue -> VariableValue -> Bool
Eq, Eq VariableValue
Eq VariableValue
-> (VariableValue -> VariableValue -> Ordering)
-> (VariableValue -> VariableValue -> Bool)
-> (VariableValue -> VariableValue -> Bool)
-> (VariableValue -> VariableValue -> Bool)
-> (VariableValue -> VariableValue -> Bool)
-> (VariableValue -> VariableValue -> VariableValue)
-> (VariableValue -> VariableValue -> VariableValue)
-> Ord VariableValue
VariableValue -> VariableValue -> Bool
VariableValue -> VariableValue -> Ordering
VariableValue -> VariableValue -> VariableValue
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 :: VariableValue -> VariableValue -> VariableValue
$cmin :: VariableValue -> VariableValue -> VariableValue
max :: VariableValue -> VariableValue -> VariableValue
$cmax :: VariableValue -> VariableValue -> VariableValue
>= :: VariableValue -> VariableValue -> Bool
$c>= :: VariableValue -> VariableValue -> Bool
> :: VariableValue -> VariableValue -> Bool
$c> :: VariableValue -> VariableValue -> Bool
<= :: VariableValue -> VariableValue -> Bool
$c<= :: VariableValue -> VariableValue -> Bool
< :: VariableValue -> VariableValue -> Bool
$c< :: VariableValue -> VariableValue -> Bool
compare :: VariableValue -> VariableValue -> Ordering
$ccompare :: VariableValue -> VariableValue -> Ordering
$cp1Ord :: Eq VariableValue
Ord, (forall x. VariableValue -> Rep VariableValue x)
-> (forall x. Rep VariableValue x -> VariableValue)
-> Generic VariableValue
forall x. Rep VariableValue x -> VariableValue
forall x. VariableValue -> Rep VariableValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VariableValue x -> VariableValue
$cfrom :: forall x. VariableValue -> Rep VariableValue x
Generic, VariableValue -> ()
(VariableValue -> ()) -> NFData VariableValue
forall a. (a -> ()) -> NFData a
rnf :: VariableValue -> ()
$crnf :: VariableValue -> ()
NFData)
data VariableState = VariableState {
VariableState -> VariableValue
variableValue :: VariableValue,
VariableState -> VariableProperties
variableProperties :: VariableProperties
}
deriving (Int -> VariableState -> ShowS
[VariableState] -> ShowS
VariableState -> String
(Int -> VariableState -> ShowS)
-> (VariableState -> String)
-> ([VariableState] -> ShowS)
-> Show VariableState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariableState] -> ShowS
$cshowList :: [VariableState] -> ShowS
show :: VariableState -> String
$cshow :: VariableState -> String
showsPrec :: Int -> VariableState -> ShowS
$cshowsPrec :: Int -> VariableState -> ShowS
Show, VariableState -> VariableState -> Bool
(VariableState -> VariableState -> Bool)
-> (VariableState -> VariableState -> Bool) -> Eq VariableState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariableState -> VariableState -> Bool
$c/= :: VariableState -> VariableState -> Bool
== :: VariableState -> VariableState -> Bool
$c== :: VariableState -> VariableState -> Bool
Eq, Eq VariableState
Eq VariableState
-> (VariableState -> VariableState -> Ordering)
-> (VariableState -> VariableState -> Bool)
-> (VariableState -> VariableState -> Bool)
-> (VariableState -> VariableState -> Bool)
-> (VariableState -> VariableState -> Bool)
-> (VariableState -> VariableState -> VariableState)
-> (VariableState -> VariableState -> VariableState)
-> Ord VariableState
VariableState -> VariableState -> Bool
VariableState -> VariableState -> Ordering
VariableState -> VariableState -> VariableState
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 :: VariableState -> VariableState -> VariableState
$cmin :: VariableState -> VariableState -> VariableState
max :: VariableState -> VariableState -> VariableState
$cmax :: VariableState -> VariableState -> VariableState
>= :: VariableState -> VariableState -> Bool
$c>= :: VariableState -> VariableState -> Bool
> :: VariableState -> VariableState -> Bool
$c> :: VariableState -> VariableState -> Bool
<= :: VariableState -> VariableState -> Bool
$c<= :: VariableState -> VariableState -> Bool
< :: VariableState -> VariableState -> Bool
$c< :: VariableState -> VariableState -> Bool
compare :: VariableState -> VariableState -> Ordering
$ccompare :: VariableState -> VariableState -> Ordering
$cp1Ord :: Eq VariableState
Ord, (forall x. VariableState -> Rep VariableState x)
-> (forall x. Rep VariableState x -> VariableState)
-> Generic VariableState
forall x. Rep VariableState x -> VariableState
forall x. VariableState -> Rep VariableState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VariableState x -> VariableState
$cfrom :: forall x. VariableState -> Rep VariableState x
Generic, VariableState -> ()
(VariableState -> ()) -> NFData VariableState
forall a. (a -> ()) -> NFData a
rnf :: VariableState -> ()
$crnf :: VariableState -> ()
NFData)
data SpaceStatus = SpaceStatusEmpty | SpaceStatusClean | SpaceStatusDirty deriving (Int -> SpaceStatus -> ShowS
[SpaceStatus] -> ShowS
SpaceStatus -> String
(Int -> SpaceStatus -> ShowS)
-> (SpaceStatus -> String)
-> ([SpaceStatus] -> ShowS)
-> Show SpaceStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpaceStatus] -> ShowS
$cshowList :: [SpaceStatus] -> ShowS
show :: SpaceStatus -> String
$cshow :: SpaceStatus -> String
showsPrec :: Int -> SpaceStatus -> ShowS
$cshowsPrec :: Int -> SpaceStatus -> ShowS
Show, SpaceStatus -> SpaceStatus -> Bool
(SpaceStatus -> SpaceStatus -> Bool)
-> (SpaceStatus -> SpaceStatus -> Bool) -> Eq SpaceStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpaceStatus -> SpaceStatus -> Bool
$c/= :: SpaceStatus -> SpaceStatus -> Bool
== :: SpaceStatus -> SpaceStatus -> Bool
$c== :: SpaceStatus -> SpaceStatus -> Bool
Eq, Eq SpaceStatus
Eq SpaceStatus
-> (SpaceStatus -> SpaceStatus -> Ordering)
-> (SpaceStatus -> SpaceStatus -> Bool)
-> (SpaceStatus -> SpaceStatus -> Bool)
-> (SpaceStatus -> SpaceStatus -> Bool)
-> (SpaceStatus -> SpaceStatus -> Bool)
-> (SpaceStatus -> SpaceStatus -> SpaceStatus)
-> (SpaceStatus -> SpaceStatus -> SpaceStatus)
-> Ord SpaceStatus
SpaceStatus -> SpaceStatus -> Bool
SpaceStatus -> SpaceStatus -> Ordering
SpaceStatus -> SpaceStatus -> SpaceStatus
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 :: SpaceStatus -> SpaceStatus -> SpaceStatus
$cmin :: SpaceStatus -> SpaceStatus -> SpaceStatus
max :: SpaceStatus -> SpaceStatus -> SpaceStatus
$cmax :: SpaceStatus -> SpaceStatus -> SpaceStatus
>= :: SpaceStatus -> SpaceStatus -> Bool
$c>= :: SpaceStatus -> SpaceStatus -> Bool
> :: SpaceStatus -> SpaceStatus -> Bool
$c> :: SpaceStatus -> SpaceStatus -> Bool
<= :: SpaceStatus -> SpaceStatus -> Bool
$c<= :: SpaceStatus -> SpaceStatus -> Bool
< :: SpaceStatus -> SpaceStatus -> Bool
$c< :: SpaceStatus -> SpaceStatus -> Bool
compare :: SpaceStatus -> SpaceStatus -> Ordering
$ccompare :: SpaceStatus -> SpaceStatus -> Ordering
$cp1Ord :: Eq SpaceStatus
Ord, (forall x. SpaceStatus -> Rep SpaceStatus x)
-> (forall x. Rep SpaceStatus x -> SpaceStatus)
-> Generic SpaceStatus
forall x. Rep SpaceStatus x -> SpaceStatus
forall x. SpaceStatus -> Rep SpaceStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpaceStatus x -> SpaceStatus
$cfrom :: forall x. SpaceStatus -> Rep SpaceStatus x
Generic, SpaceStatus -> ()
(SpaceStatus -> ()) -> NFData SpaceStatus
forall a. (a -> ()) -> NFData a
rnf :: SpaceStatus -> ()
$crnf :: SpaceStatus -> ()
NFData)
data NumericalStatus = NumericalStatusUnknown | NumericalStatusEmpty | NumericalStatusMaybe | NumericalStatusDefinitely deriving (Int -> NumericalStatus -> ShowS
[NumericalStatus] -> ShowS
NumericalStatus -> String
(Int -> NumericalStatus -> ShowS)
-> (NumericalStatus -> String)
-> ([NumericalStatus] -> ShowS)
-> Show NumericalStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumericalStatus] -> ShowS
$cshowList :: [NumericalStatus] -> ShowS
show :: NumericalStatus -> String
$cshow :: NumericalStatus -> String
showsPrec :: Int -> NumericalStatus -> ShowS
$cshowsPrec :: Int -> NumericalStatus -> ShowS
Show, NumericalStatus -> NumericalStatus -> Bool
(NumericalStatus -> NumericalStatus -> Bool)
-> (NumericalStatus -> NumericalStatus -> Bool)
-> Eq NumericalStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumericalStatus -> NumericalStatus -> Bool
$c/= :: NumericalStatus -> NumericalStatus -> Bool
== :: NumericalStatus -> NumericalStatus -> Bool
$c== :: NumericalStatus -> NumericalStatus -> Bool
Eq, Eq NumericalStatus
Eq NumericalStatus
-> (NumericalStatus -> NumericalStatus -> Ordering)
-> (NumericalStatus -> NumericalStatus -> Bool)
-> (NumericalStatus -> NumericalStatus -> Bool)
-> (NumericalStatus -> NumericalStatus -> Bool)
-> (NumericalStatus -> NumericalStatus -> Bool)
-> (NumericalStatus -> NumericalStatus -> NumericalStatus)
-> (NumericalStatus -> NumericalStatus -> NumericalStatus)
-> Ord NumericalStatus
NumericalStatus -> NumericalStatus -> Bool
NumericalStatus -> NumericalStatus -> Ordering
NumericalStatus -> NumericalStatus -> NumericalStatus
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 :: NumericalStatus -> NumericalStatus -> NumericalStatus
$cmin :: NumericalStatus -> NumericalStatus -> NumericalStatus
max :: NumericalStatus -> NumericalStatus -> NumericalStatus
$cmax :: NumericalStatus -> NumericalStatus -> NumericalStatus
>= :: NumericalStatus -> NumericalStatus -> Bool
$c>= :: NumericalStatus -> NumericalStatus -> Bool
> :: NumericalStatus -> NumericalStatus -> Bool
$c> :: NumericalStatus -> NumericalStatus -> Bool
<= :: NumericalStatus -> NumericalStatus -> Bool
$c<= :: NumericalStatus -> NumericalStatus -> Bool
< :: NumericalStatus -> NumericalStatus -> Bool
$c< :: NumericalStatus -> NumericalStatus -> Bool
compare :: NumericalStatus -> NumericalStatus -> Ordering
$ccompare :: NumericalStatus -> NumericalStatus -> Ordering
$cp1Ord :: Eq NumericalStatus
Ord, (forall x. NumericalStatus -> Rep NumericalStatus x)
-> (forall x. Rep NumericalStatus x -> NumericalStatus)
-> Generic NumericalStatus
forall x. Rep NumericalStatus x -> NumericalStatus
forall x. NumericalStatus -> Rep NumericalStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumericalStatus x -> NumericalStatus
$cfrom :: forall x. NumericalStatus -> Rep NumericalStatus x
Generic, NumericalStatus -> ()
(NumericalStatus -> ()) -> NFData NumericalStatus
forall a. (a -> ()) -> NFData a
rnf :: NumericalStatus -> ()
$crnf :: NumericalStatus -> ()
NFData)
type VariableProperties = S.Set (S.Set CFVariableProp)
defaultProperties :: Set (Set a)
defaultProperties = Set a -> Set (Set a)
forall a. a -> Set a
S.singleton Set a
forall a. Set a
S.empty
unknownVariableState :: VariableState
unknownVariableState = VariableState :: VariableValue -> VariableProperties -> VariableState
VariableState {
variableValue :: VariableValue
variableValue = VariableValue
unknownVariableValue,
variableProperties :: VariableProperties
variableProperties = VariableProperties
forall a. Set (Set a)
defaultProperties
}
unknownVariableValue :: VariableValue
unknownVariableValue = VariableValue :: Maybe String -> SpaceStatus -> NumericalStatus -> VariableValue
VariableValue {
literalValue :: Maybe String
literalValue = Maybe String
forall a. Maybe a
Nothing,
spaceStatus :: SpaceStatus
spaceStatus = SpaceStatus
SpaceStatusDirty,
numericalStatus :: NumericalStatus
numericalStatus = NumericalStatus
NumericalStatusUnknown
}
emptyVariableValue :: VariableValue
emptyVariableValue = VariableValue
unknownVariableValue {
literalValue :: Maybe String
literalValue = String -> Maybe String
forall a. a -> Maybe a
Just String
"",
spaceStatus :: SpaceStatus
spaceStatus = SpaceStatus
SpaceStatusEmpty,
numericalStatus :: NumericalStatus
numericalStatus = NumericalStatus
NumericalStatusEmpty
}
unsetVariableState :: VariableState
unsetVariableState = VariableState :: VariableValue -> VariableProperties -> VariableState
VariableState {
variableValue :: VariableValue
variableValue = VariableValue
emptyVariableValue,
variableProperties :: VariableProperties
variableProperties = VariableProperties
forall a. Set (Set a)
defaultProperties
}
mergeVariableState :: VariableState -> VariableState -> VariableState
mergeVariableState VariableState
a VariableState
b = VariableState :: VariableValue -> VariableProperties -> VariableState
VariableState {
variableValue :: VariableValue
variableValue = VariableValue -> VariableValue -> VariableValue
mergeVariableValue (VariableState -> VariableValue
variableValue VariableState
a) (VariableState -> VariableValue
variableValue VariableState
b),
variableProperties :: VariableProperties
variableProperties = VariableProperties -> VariableProperties -> VariableProperties
forall a. Ord a => Set a -> Set a -> Set a
S.union (VariableState -> VariableProperties
variableProperties VariableState
a) (VariableState -> VariableProperties
variableProperties VariableState
b)
}
mergeVariableValue :: VariableValue -> VariableValue -> VariableValue
mergeVariableValue VariableValue
a VariableValue
b = VariableValue :: Maybe String -> SpaceStatus -> NumericalStatus -> VariableValue
VariableValue {
literalValue :: Maybe String
literalValue = if VariableValue -> Maybe String
literalValue VariableValue
a Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== VariableValue -> Maybe String
literalValue VariableValue
b then VariableValue -> Maybe String
literalValue VariableValue
a else Maybe String
forall a. Maybe a
Nothing,
spaceStatus :: SpaceStatus
spaceStatus = SpaceStatus -> SpaceStatus -> SpaceStatus
mergeSpaceStatus (VariableValue -> SpaceStatus
spaceStatus VariableValue
a) (VariableValue -> SpaceStatus
spaceStatus VariableValue
b),
numericalStatus :: NumericalStatus
numericalStatus = NumericalStatus -> NumericalStatus -> NumericalStatus
mergeNumericalStatus (VariableValue -> NumericalStatus
numericalStatus VariableValue
a) (VariableValue -> NumericalStatus
numericalStatus VariableValue
b)
}
mergeSpaceStatus :: SpaceStatus -> SpaceStatus -> SpaceStatus
mergeSpaceStatus SpaceStatus
a SpaceStatus
b =
case (SpaceStatus
a,SpaceStatus
b) of
(SpaceStatus
SpaceStatusEmpty, SpaceStatus
y) -> SpaceStatus
y
(SpaceStatus
x, SpaceStatus
SpaceStatusEmpty) -> SpaceStatus
x
(SpaceStatus
SpaceStatusClean, SpaceStatus
SpaceStatusClean) -> SpaceStatus
SpaceStatusClean
(SpaceStatus, SpaceStatus)
_ -> SpaceStatus
SpaceStatusDirty
mergeNumericalStatus :: NumericalStatus -> NumericalStatus -> NumericalStatus
mergeNumericalStatus NumericalStatus
a NumericalStatus
b =
case (NumericalStatus
a,NumericalStatus
b) of
(NumericalStatus
NumericalStatusDefinitely, NumericalStatus
NumericalStatusDefinitely) -> NumericalStatus
NumericalStatusDefinitely
(NumericalStatus
NumericalStatusDefinitely, NumericalStatus
_) -> NumericalStatus
NumericalStatusMaybe
(NumericalStatus
_, NumericalStatus
NumericalStatusDefinitely) -> NumericalStatus
NumericalStatusMaybe
(NumericalStatus
NumericalStatusMaybe, NumericalStatus
_) -> NumericalStatus
NumericalStatusMaybe
(NumericalStatus
_, NumericalStatus
NumericalStatusMaybe) -> NumericalStatus
NumericalStatusMaybe
(NumericalStatus
NumericalStatusEmpty, NumericalStatus
NumericalStatusEmpty) -> NumericalStatus
NumericalStatusEmpty
(NumericalStatus, NumericalStatus)
_ -> NumericalStatus
NumericalStatusUnknown
data VersionedMap k v = VersionedMap {
VersionedMap k v -> Integer
mapVersion :: Integer,
VersionedMap k v -> Map k v
mapStorage :: M.Map k v
}
deriving ((forall x. VersionedMap k v -> Rep (VersionedMap k v) x)
-> (forall x. Rep (VersionedMap k v) x -> VersionedMap k v)
-> Generic (VersionedMap k v)
forall x. Rep (VersionedMap k v) x -> VersionedMap k v
forall x. VersionedMap k v -> Rep (VersionedMap k v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (VersionedMap k v) x -> VersionedMap k v
forall k v x. VersionedMap k v -> Rep (VersionedMap k v) x
$cto :: forall k v x. Rep (VersionedMap k v) x -> VersionedMap k v
$cfrom :: forall k v x. VersionedMap k v -> Rep (VersionedMap k v) x
Generic, VersionedMap k v -> ()
(VersionedMap k v -> ()) -> NFData (VersionedMap k v)
forall a. (a -> ()) -> NFData a
forall k v. (NFData k, NFData v) => VersionedMap k v -> ()
rnf :: VersionedMap k v -> ()
$crnf :: forall k v. (NFData k, NFData v) => VersionedMap k v -> ()
NFData)
instance (Show k, Show v) => Show (VersionedMap k v) where
show :: VersionedMap k v -> String
show VersionedMap k v
m = (if VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then String
"V" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
m) else String
"U") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map k v -> String
forall a. Show a => a -> String
show (VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
m)
instance Eq InternalState where
== :: InternalState -> InternalState -> Bool
(==) InternalState
a InternalState
b = InternalState -> InternalState -> Bool
stateIsQuickEqual InternalState
a InternalState
b Bool -> Bool -> Bool
|| InternalState -> InternalState -> Bool
stateIsSlowEqual InternalState
a InternalState
b
instance (Eq k, Eq v) => Eq (VersionedMap k v) where
== :: VersionedMap k v -> VersionedMap k v -> Bool
(==) VersionedMap k v
a VersionedMap k v
b = VersionedMap k v -> VersionedMap k v -> Bool
forall k v. VersionedMap k v -> VersionedMap k v -> Bool
vmIsQuickEqual VersionedMap k v
a VersionedMap k v
b Bool -> Bool -> Bool
|| VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
a Map k v -> Map k v -> Bool
forall a. Eq a => a -> a -> Bool
== VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
b
instance (Ord k, Ord v) => Ord (VersionedMap k v) where
compare :: VersionedMap k v -> VersionedMap k v -> Ordering
compare VersionedMap k v
a VersionedMap k v
b =
if VersionedMap k v -> VersionedMap k v -> Bool
forall k v. VersionedMap k v -> VersionedMap k v -> Bool
vmIsQuickEqual VersionedMap k v
a VersionedMap k v
b
then Ordering
EQ
else VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
a Map k v -> Map k v -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
b
data Ctx s = Ctx {
Ctx s -> STRef s Int
cNode :: STRef s Node,
Ctx s -> STRef s InternalState
cInput :: STRef s InternalState,
Ctx s -> STRef s InternalState
cOutput :: STRef s InternalState,
Ctx s -> [StackEntry s]
cStack :: [StackEntry s],
Ctx s -> CFGraph
cGraph :: CFGraph,
Ctx s -> STRef s Integer
cCounter :: STRef s Integer,
Ctx s -> STRef s (Map Int [(Set StateDependency, InternalState)])
cCache :: STRef s (M.Map Node [(S.Set StateDependency, InternalState)]),
Ctx s -> STRef s Bool
cEnableCache :: STRef s Bool,
Ctx s
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
cInvocations :: STRef s (M.Map [Node] (S.Set StateDependency, M.Map Node (InternalState, InternalState)))
}
data StackEntry s = StackEntry {
StackEntry s -> Int
entryPoint :: Node,
StackEntry s -> Bool
isFunctionCall :: Bool,
StackEntry s -> Int
callSite :: Node,
StackEntry s -> STRef s (Set StateDependency)
dependencies :: STRef s (S.Set StateDependency),
StackEntry s -> InternalState
stackState :: InternalState
}
deriving (StackEntry s -> StackEntry s -> Bool
(StackEntry s -> StackEntry s -> Bool)
-> (StackEntry s -> StackEntry s -> Bool) -> Eq (StackEntry s)
forall s. StackEntry s -> StackEntry s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackEntry s -> StackEntry s -> Bool
$c/= :: forall s. StackEntry s -> StackEntry s -> Bool
== :: StackEntry s -> StackEntry s -> Bool
$c== :: forall s. StackEntry s -> StackEntry s -> Bool
Eq, (forall x. StackEntry s -> Rep (StackEntry s) x)
-> (forall x. Rep (StackEntry s) x -> StackEntry s)
-> Generic (StackEntry s)
forall x. Rep (StackEntry s) x -> StackEntry s
forall x. StackEntry s -> Rep (StackEntry s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (StackEntry s) x -> StackEntry s
forall s x. StackEntry s -> Rep (StackEntry s) x
$cto :: forall s x. Rep (StackEntry s) x -> StackEntry s
$cfrom :: forall s x. StackEntry s -> Rep (StackEntry s) x
Generic, StackEntry s -> ()
(StackEntry s -> ()) -> NFData (StackEntry s)
forall s. StackEntry s -> ()
forall a. (a -> ()) -> NFData a
rnf :: StackEntry s -> ()
$crnf :: forall s. StackEntry s -> ()
NFData)
#if MIN_VERSION_deepseq(1,4,2)
#else
instance NFData (STRef s a) where
rnf = (`seq` ())
#endif
patchState :: InternalState -> InternalState -> InternalState
patchState :: InternalState -> InternalState -> InternalState
patchState InternalState
base InternalState
diff =
case () of
()
_ | InternalState -> Integer
sVersion InternalState
diff Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> InternalState
base
()
_ | InternalState -> Integer
sVersion InternalState
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> InternalState
diff
()
_ | InternalState -> InternalState -> Bool
stateIsQuickEqual InternalState
base InternalState
diff -> InternalState
diff
()
_ ->
InternalState :: Integer
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String FunctionValue
-> Maybe (Set Id)
-> Maybe Bool
-> InternalState
InternalState {
sVersion :: Integer
sVersion = -Integer
1,
sGlobalValues :: VersionedMap String VariableState
sGlobalValues = VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall k v.
Ord k =>
VersionedMap k v -> VersionedMap k v -> VersionedMap k v
vmPatch (InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
base) (InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
diff),
sLocalValues :: VersionedMap String VariableState
sLocalValues = VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall k v.
Ord k =>
VersionedMap k v -> VersionedMap k v -> VersionedMap k v
vmPatch (InternalState -> VersionedMap String VariableState
sLocalValues InternalState
base) (InternalState -> VersionedMap String VariableState
sLocalValues InternalState
diff),
sPrefixValues :: VersionedMap String VariableState
sPrefixValues = VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
forall k v.
Ord k =>
VersionedMap k v -> VersionedMap k v -> VersionedMap k v
vmPatch (InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
base) (InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
diff),
sFunctionTargets :: VersionedMap String FunctionValue
sFunctionTargets = VersionedMap String FunctionValue
-> VersionedMap String FunctionValue
-> VersionedMap String FunctionValue
forall k v.
Ord k =>
VersionedMap k v -> VersionedMap k v -> VersionedMap k v
vmPatch (InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
base) (InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
diff),
sExitCodes :: Maybe (Set Id)
sExitCodes = InternalState -> Maybe (Set Id)
sExitCodes InternalState
diff Maybe (Set Id) -> Maybe (Set Id) -> Maybe (Set Id)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` InternalState -> Maybe (Set Id)
sExitCodes InternalState
base,
sIsReachable :: Maybe Bool
sIsReachable = InternalState -> Maybe Bool
sIsReachable InternalState
diff Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` InternalState -> Maybe Bool
sIsReachable InternalState
base
}
patchOutputM :: Ctx s -> InternalState -> ST s ()
patchOutputM Ctx s
ctx InternalState
diff = do
let cOut :: STRef s InternalState
cOut = Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx
InternalState
oldState <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
cOut
let newState :: InternalState
newState = InternalState -> InternalState -> InternalState
patchState InternalState
oldState InternalState
diff
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
cOut InternalState
newState
mergeState :: forall s. Ctx s -> InternalState -> InternalState -> ST s InternalState
mergeState :: Ctx s -> InternalState -> InternalState -> ST s InternalState
mergeState Ctx s
ctx InternalState
a InternalState
b = do
let cin :: STRef s InternalState
cin = Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cInput Ctx s
ctx
InternalState
old <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
cin
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
cin InternalState
newInternalState
InternalState
x <- InternalState -> InternalState -> ST s InternalState
merge InternalState
a InternalState
b
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
cin InternalState
old
InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
x
where
merge :: InternalState -> InternalState -> ST s InternalState
merge InternalState
a InternalState
b =
case () of
()
_ | InternalState -> Maybe Bool
sIsReachable InternalState
a Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
&& InternalState -> Maybe Bool
sIsReachable InternalState
b Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
Bool -> Bool -> Bool
|| InternalState -> Maybe Bool
sIsReachable InternalState
a Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Bool -> Bool -> Bool
&& InternalState -> Maybe Bool
sIsReachable InternalState
b Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True ->
String -> ST s InternalState
forall a. HasCallStack => String -> a
error (String -> ST s InternalState) -> String -> ST s InternalState
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Unexpected merge of reachable and unreachable state"
()
_ | InternalState -> Maybe Bool
sIsReachable InternalState
a Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Bool -> Bool -> Bool
&& InternalState -> Maybe Bool
sIsReachable InternalState
b Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False ->
InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
unreachableState
()
_ | InternalState -> Integer
sVersion InternalState
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& InternalState -> Integer
sVersion InternalState
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& InternalState -> Integer
sVersion InternalState
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== InternalState -> Integer
sVersion InternalState
b -> InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
a
()
_ -> do
VersionedMap String VariableState
globals <- Ctx s
-> (VariableState -> VariableState -> VariableState)
-> (Ctx s -> String -> ST s VariableState)
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> ST s (VersionedMap String VariableState)
forall k v s.
Ord k =>
Ctx s
-> (v -> v -> v)
-> (Ctx s -> k -> ST s v)
-> VersionedMap k v
-> VersionedMap k v
-> ST s (VersionedMap k v)
mergeMaps Ctx s
ctx VariableState -> VariableState -> VariableState
mergeVariableState Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readGlobal (InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
a) (InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
b)
VersionedMap String VariableState
locals <- Ctx s
-> (VariableState -> VariableState -> VariableState)
-> (Ctx s -> String -> ST s VariableState)
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> ST s (VersionedMap String VariableState)
forall k v s.
Ord k =>
Ctx s
-> (v -> v -> v)
-> (Ctx s -> k -> ST s v)
-> VersionedMap k v
-> VersionedMap k v
-> ST s (VersionedMap k v)
mergeMaps Ctx s
ctx VariableState -> VariableState -> VariableState
mergeVariableState Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readVariable (InternalState -> VersionedMap String VariableState
sLocalValues InternalState
a) (InternalState -> VersionedMap String VariableState
sLocalValues InternalState
b)
VersionedMap String VariableState
prefix <- Ctx s
-> (VariableState -> VariableState -> VariableState)
-> (Ctx s -> String -> ST s VariableState)
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> ST s (VersionedMap String VariableState)
forall k v s.
Ord k =>
Ctx s
-> (v -> v -> v)
-> (Ctx s -> k -> ST s v)
-> VersionedMap k v
-> VersionedMap k v
-> ST s (VersionedMap k v)
mergeMaps Ctx s
ctx VariableState -> VariableState -> VariableState
mergeVariableState Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readVariable (InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
a) (InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
b)
VersionedMap String FunctionValue
funcs <- Ctx s
-> (FunctionValue -> FunctionValue -> FunctionValue)
-> (Ctx s -> String -> ST s FunctionValue)
-> VersionedMap String FunctionValue
-> VersionedMap String FunctionValue
-> ST s (VersionedMap String FunctionValue)
forall k v s.
Ord k =>
Ctx s
-> (v -> v -> v)
-> (Ctx s -> k -> ST s v)
-> VersionedMap k v
-> VersionedMap k v
-> ST s (VersionedMap k v)
mergeMaps Ctx s
ctx FunctionValue -> FunctionValue -> FunctionValue
forall a. Ord a => Set a -> Set a -> Set a
S.union Ctx s -> String -> ST s FunctionValue
forall s. Ctx s -> String -> ST s FunctionValue
readFunction (InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
a) (InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
b)
Maybe (Set Id)
exitCodes <- Ctx s
-> (Set Id -> Set Id -> Set Id)
-> (Ctx s -> ST s (Set Id))
-> Maybe (Set Id)
-> Maybe (Set Id)
-> ST s (Maybe (Set Id))
forall (m :: * -> *) p a a.
Monad m =>
p
-> (a -> a -> a) -> (p -> m a) -> Maybe a -> Maybe a -> m (Maybe a)
mergeMaybes Ctx s
ctx Set Id -> Set Id -> Set Id
forall a. Ord a => Set a -> Set a -> Set a
S.union Ctx s -> ST s (Set Id)
forall s. Ctx s -> ST s (Set Id)
readExitCodes (InternalState -> Maybe (Set Id)
sExitCodes InternalState
a) (InternalState -> Maybe (Set Id)
sExitCodes InternalState
b)
InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalState -> ST s InternalState)
-> InternalState -> ST s InternalState
forall a b. (a -> b) -> a -> b
$ InternalState :: Integer
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String VariableState
-> VersionedMap String FunctionValue
-> Maybe (Set Id)
-> Maybe Bool
-> InternalState
InternalState {
sVersion :: Integer
sVersion = -Integer
1,
sGlobalValues :: VersionedMap String VariableState
sGlobalValues = VersionedMap String VariableState
globals,
sLocalValues :: VersionedMap String VariableState
sLocalValues = VersionedMap String VariableState
locals,
sPrefixValues :: VersionedMap String VariableState
sPrefixValues = VersionedMap String VariableState
prefix,
sFunctionTargets :: VersionedMap String FunctionValue
sFunctionTargets = VersionedMap String FunctionValue
funcs,
sExitCodes :: Maybe (Set Id)
sExitCodes = Maybe (Set Id)
exitCodes,
sIsReachable :: Maybe Bool
sIsReachable = (Bool -> Bool -> Bool) -> Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(&&) (InternalState -> Maybe Bool
sIsReachable InternalState
a) (InternalState -> Maybe Bool
sIsReachable InternalState
b)
}
mergeStates :: forall s. Ctx s -> InternalState -> [InternalState] -> ST s InternalState
mergeStates :: Ctx s -> InternalState -> [InternalState] -> ST s InternalState
mergeStates Ctx s
ctx InternalState
def [InternalState]
list =
case [InternalState]
list of
[] -> InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
def
(InternalState
first:[InternalState]
rest) -> (InternalState -> InternalState -> ST s InternalState)
-> InternalState -> [InternalState] -> ST s InternalState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ctx s -> InternalState -> InternalState -> ST s InternalState
forall s.
Ctx s -> InternalState -> InternalState -> ST s InternalState
mergeState Ctx s
ctx) InternalState
first [InternalState]
rest
mergeMaps :: (Ord k) => forall s.
Ctx s ->
(v -> v -> v) ->
(Ctx s -> k -> ST s v) ->
(VersionedMap k v) ->
(VersionedMap k v) ->
ST s (VersionedMap k v)
mergeMaps :: forall s.
Ctx s
-> (v -> v -> v)
-> (Ctx s -> k -> ST s v)
-> VersionedMap k v
-> VersionedMap k v
-> ST s (VersionedMap k v)
mergeMaps Ctx s
ctx v -> v -> v
merger Ctx s -> k -> ST s v
reader VersionedMap k v
a VersionedMap k v
b =
if VersionedMap k v -> VersionedMap k v -> Bool
forall k v. VersionedMap k v -> VersionedMap k v -> Bool
vmIsQuickEqual VersionedMap k v
a VersionedMap k v
b
then VersionedMap k v -> ST s (VersionedMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return VersionedMap k v
a
else do
Map k v
new <- [(k, v)] -> Map k v
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList ([(k, v)] -> Map k v)
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> Map k v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(k, v)] -> [(k, v)]
forall a. [a] -> [a]
reverse ([(k, v)] -> Map k v) -> ST s [(k, v)] -> ST s (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(k, v)] -> [(k, v)] -> [(k, v)] -> ST s [(k, v)]
f [] (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map k v -> [(k, v)]) -> Map k v -> [(k, v)]
forall a b. (a -> b) -> a -> b
$ VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
a) (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map k v -> [(k, v)]) -> Map k v -> [(k, v)]
forall a b. (a -> b) -> a -> b
$ VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
b)
Ctx s -> Map k v -> ST s (VersionedMap k v)
forall (m :: * -> *) p k v.
Monad m =>
p -> Map k v -> m (VersionedMap k v)
vmFromMap Ctx s
ctx Map k v
new
where
f :: [(k, v)] -> [(k, v)] -> [(k, v)] -> ST s [(k, v)]
f [(k, v)]
l [] [] = [(k, v)] -> ST s [(k, v)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(k, v)]
l
f [(k, v)]
l [] [(k, v)]
b = [(k, v)] -> [(k, v)] -> [(k, v)] -> ST s [(k, v)]
f [(k, v)]
l [(k, v)]
b []
f [(k, v)]
l ((k
k,v
v):[(k, v)]
rest1) [] = do
v
other <- Ctx s -> k -> ST s v
reader Ctx s
ctx k
k
[(k, v)] -> [(k, v)] -> [(k, v)] -> ST s [(k, v)]
f ((k
k, v -> v -> v
merger v
v v
other)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
l) [(k, v)]
rest1 []
f [(k, v)]
l l1 :: [(k, v)]
l1@((k
k1, v
v1):[(k, v)]
rest1) l2 :: [(k, v)]
l2@((k
k2, v
v2):[(k, v)]
rest2) =
case k
k1 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
k2 of
Ordering
EQ ->
[(k, v)] -> [(k, v)] -> [(k, v)] -> ST s [(k, v)]
f ((k
k1, v -> v -> v
merger v
v1 v
v2)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
l) [(k, v)]
rest1 [(k, v)]
rest2
Ordering
LT -> do
v
nv2 <- Ctx s -> k -> ST s v
reader Ctx s
ctx k
k1
[(k, v)] -> [(k, v)] -> [(k, v)] -> ST s [(k, v)]
f ((k
k1, v -> v -> v
merger v
v1 v
nv2)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
l) [(k, v)]
rest1 [(k, v)]
l2
Ordering
GT -> do
v
nv1 <- Ctx s -> k -> ST s v
reader Ctx s
ctx k
k2
[(k, v)] -> [(k, v)] -> [(k, v)] -> ST s [(k, v)]
f ((k
k2, v -> v -> v
merger v
nv1 v
v2)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
l) [(k, v)]
l1 [(k, v)]
rest2
mergeMaybes :: p
-> (a -> a -> a) -> (p -> m a) -> Maybe a -> Maybe a -> m (Maybe a)
mergeMaybes p
ctx a -> a -> a
merger p -> m a
reader Maybe a
a Maybe a
b =
case (Maybe a
a, Maybe a
b) of
(Maybe a
Nothing, Maybe a
Nothing) -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
(Just a
v1, Maybe a
Nothing) -> a -> m (Maybe a)
single a
v1
(Maybe a
Nothing, Just a
v2) -> a -> m (Maybe a)
single a
v2
(Just a
v1, Just a
v2) -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
merger a
v1 a
v2
where
single :: a -> m (Maybe a)
single a
val = do
a
result <- a -> a -> a
merger a
val (a -> a) -> m a -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> m a
reader p
ctx
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
result
vmFromMap :: p -> Map k v -> m (VersionedMap k v)
vmFromMap p
ctx Map k v
map = VersionedMap k v -> m (VersionedMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (VersionedMap k v -> m (VersionedMap k v))
-> VersionedMap k v -> m (VersionedMap k v)
forall a b. (a -> b) -> a -> b
$ VersionedMap :: forall k v. Integer -> Map k v -> VersionedMap k v
VersionedMap {
mapVersion :: Integer
mapVersion = -Integer
1,
mapStorage :: Map k v
mapStorage = Map k v
map
}
versionMap :: Ctx s -> VersionedMap k v -> ST s (VersionedMap k v)
versionMap Ctx s
ctx VersionedMap k v
map =
if VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
map Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
then VersionedMap k v -> ST s (VersionedMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return VersionedMap k v
map
else do
Integer
v <- Ctx s -> ST s Integer
forall s. Ctx s -> ST s Integer
nextVersion Ctx s
ctx
VersionedMap k v -> ST s (VersionedMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return VersionedMap k v
map {
mapVersion :: Integer
mapVersion = Integer
v
}
versionState :: Ctx s -> InternalState -> ST s InternalState
versionState Ctx s
ctx InternalState
state =
if InternalState -> Integer
sVersion InternalState
state Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
then InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
state
else do
Integer
self <- Ctx s -> ST s Integer
forall s. Ctx s -> ST s Integer
nextVersion Ctx s
ctx
VersionedMap String VariableState
ssGlobalValues <- Ctx s
-> VersionedMap String VariableState
-> ST s (VersionedMap String VariableState)
forall s k v. Ctx s -> VersionedMap k v -> ST s (VersionedMap k v)
versionMap Ctx s
ctx (VersionedMap String VariableState
-> ST s (VersionedMap String VariableState))
-> VersionedMap String VariableState
-> ST s (VersionedMap String VariableState)
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
state
VersionedMap String VariableState
ssLocalValues <- Ctx s
-> VersionedMap String VariableState
-> ST s (VersionedMap String VariableState)
forall s k v. Ctx s -> VersionedMap k v -> ST s (VersionedMap k v)
versionMap Ctx s
ctx (VersionedMap String VariableState
-> ST s (VersionedMap String VariableState))
-> VersionedMap String VariableState
-> ST s (VersionedMap String VariableState)
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sLocalValues InternalState
state
VersionedMap String FunctionValue
ssFunctionTargets <- Ctx s
-> VersionedMap String FunctionValue
-> ST s (VersionedMap String FunctionValue)
forall s k v. Ctx s -> VersionedMap k v -> ST s (VersionedMap k v)
versionMap Ctx s
ctx (VersionedMap String FunctionValue
-> ST s (VersionedMap String FunctionValue))
-> VersionedMap String FunctionValue
-> ST s (VersionedMap String FunctionValue)
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
state
InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
state {
sVersion :: Integer
sVersion = Integer
self,
sGlobalValues :: VersionedMap String VariableState
sGlobalValues = VersionedMap String VariableState
ssGlobalValues,
sLocalValues :: VersionedMap String VariableState
sLocalValues = VersionedMap String VariableState
ssLocalValues,
sFunctionTargets :: VersionedMap String FunctionValue
sFunctionTargets = VersionedMap String FunctionValue
ssFunctionTargets
}
is2plus :: [a] -> Bool
is2plus :: [a] -> Bool
is2plus [a]
l = case [a]
l of
a
_:a
_:[a]
_ -> Bool
True
[a]
_ -> Bool
False
stateIsQuickEqual :: InternalState -> InternalState -> Bool
stateIsQuickEqual InternalState
a InternalState
b =
let
va :: Integer
va = InternalState -> Integer
sVersion InternalState
a
vb :: Integer
vb = InternalState -> Integer
sVersion InternalState
b
in
Integer
va Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
vb Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
va Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
vb
stateIsSlowEqual :: InternalState -> InternalState -> Bool
stateIsSlowEqual InternalState
a InternalState
b =
(InternalState -> VersionedMap String VariableState) -> Bool
forall a. Eq a => (InternalState -> a) -> Bool
check InternalState -> VersionedMap String VariableState
sGlobalValues
Bool -> Bool -> Bool
&& (InternalState -> VersionedMap String VariableState) -> Bool
forall a. Eq a => (InternalState -> a) -> Bool
check InternalState -> VersionedMap String VariableState
sLocalValues
Bool -> Bool -> Bool
&& (InternalState -> VersionedMap String VariableState) -> Bool
forall a. Eq a => (InternalState -> a) -> Bool
check InternalState -> VersionedMap String VariableState
sPrefixValues
Bool -> Bool -> Bool
&& (InternalState -> VersionedMap String FunctionValue) -> Bool
forall a. Eq a => (InternalState -> a) -> Bool
check InternalState -> VersionedMap String FunctionValue
sFunctionTargets
Bool -> Bool -> Bool
&& (InternalState -> Maybe Bool) -> Bool
forall a. Eq a => (InternalState -> a) -> Bool
check InternalState -> Maybe Bool
sIsReachable
where
check :: (InternalState -> a) -> Bool
check InternalState -> a
f = InternalState -> a
f InternalState
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== InternalState -> a
f InternalState
b
vmIsQuickEqual :: VersionedMap k v -> VersionedMap k v -> Bool
vmIsQuickEqual :: VersionedMap k v -> VersionedMap k v -> Bool
vmIsQuickEqual VersionedMap k v
a VersionedMap k v
b =
let
va :: Integer
va = VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
a
vb :: Integer
vb = VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
b
in
Integer
va Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
vb Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
va Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
vb
vmEmpty :: VersionedMap k v
vmEmpty = VersionedMap :: forall k v. Integer -> Map k v -> VersionedMap k v
VersionedMap {
mapVersion :: Integer
mapVersion = Integer
0,
mapStorage :: Map k v
mapStorage = Map k v
forall k a. Map k a
M.empty
}
vmNull :: VersionedMap k v -> Bool
vmNull :: VersionedMap k v -> Bool
vmNull VersionedMap k v
m = VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| (Map k v -> Bool
forall k a. Map k a -> Bool
M.null (Map k v -> Bool) -> Map k v -> Bool
forall a b. (a -> b) -> a -> b
$ VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
m)
vmLookup :: k -> VersionedMap k a -> Maybe a
vmLookup k
name VersionedMap k a
map = k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
name (Map k a -> Maybe a) -> Map k a -> Maybe a
forall a b. (a -> b) -> a -> b
$ VersionedMap k a -> Map k a
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k a
map
vmInsert :: k -> v -> VersionedMap k v -> VersionedMap k v
vmInsert k
key v
val VersionedMap k v
map = VersionedMap :: forall k v. Integer -> Map k v -> VersionedMap k v
VersionedMap {
mapVersion :: Integer
mapVersion = -Integer
1,
mapStorage :: Map k v
mapStorage = k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
key v
val (Map k v -> Map k v) -> Map k v -> Map k v
forall a b. (a -> b) -> a -> b
$ VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
map
}
vmPatch :: (Ord k) => VersionedMap k v -> VersionedMap k v -> VersionedMap k v
vmPatch :: VersionedMap k v -> VersionedMap k v -> VersionedMap k v
vmPatch VersionedMap k v
base VersionedMap k v
diff =
case () of
()
_ | VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> VersionedMap k v
diff
()
_ | VersionedMap k v -> Integer
forall k v. VersionedMap k v -> Integer
mapVersion VersionedMap k v
diff Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> VersionedMap k v
base
()
_ | VersionedMap k v -> VersionedMap k v -> Bool
forall k v. VersionedMap k v -> VersionedMap k v -> Bool
vmIsQuickEqual VersionedMap k v
base VersionedMap k v
diff -> VersionedMap k v
diff
()
_ -> VersionedMap :: forall k v. Integer -> Map k v -> VersionedMap k v
VersionedMap {
mapVersion :: Integer
mapVersion = -Integer
1,
mapStorage :: Map k v
mapStorage = (v -> v -> v) -> Map k v -> Map k v -> Map k v
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith ((v -> v -> v) -> v -> v -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> v -> v
forall a b. a -> b -> a
const) (VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
base) (VersionedMap k v -> Map k v
forall k v. VersionedMap k v -> Map k v
mapStorage VersionedMap k v
diff)
}
writeVariable :: forall s. Ctx s -> String -> VariableState -> ST s ()
writeVariable :: Ctx s -> String -> VariableState -> ST s ()
writeVariable Ctx s
ctx String
name VariableState
val = do
Scope
typ <- Ctx s -> String -> ST s Scope
forall s. Ctx s -> String -> ST s Scope
readVariableScope Ctx s
ctx String
name
case Scope
typ of
Scope
GlobalScope -> Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeGlobal Ctx s
ctx String
name VariableState
val
Scope
LocalScope -> Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name VariableState
val
Scope
PrefixScope -> Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name VariableState
val
writeGlobal :: Ctx s -> String -> VariableState -> ST s ()
writeGlobal Ctx s
ctx String
name VariableState
val = do
STRef s InternalState
-> (InternalState -> InternalState) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) ((InternalState -> InternalState) -> ST s ())
-> (InternalState -> InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> VariableState -> InternalState -> InternalState
insertGlobal String
name VariableState
val
writeLocal :: Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name VariableState
val = do
STRef s InternalState
-> (InternalState -> InternalState) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) ((InternalState -> InternalState) -> ST s ())
-> (InternalState -> InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> VariableState -> InternalState -> InternalState
insertLocal String
name VariableState
val
writePrefix :: Ctx s -> String -> VariableState -> ST s ()
writePrefix Ctx s
ctx String
name VariableState
val = do
STRef s InternalState
-> (InternalState -> InternalState) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) ((InternalState -> InternalState) -> ST s ())
-> (InternalState -> InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> VariableState -> InternalState -> InternalState
insertPrefix String
name VariableState
val
updateVariableValue :: Ctx s -> String -> VariableValue -> ST s ()
updateVariableValue Ctx s
ctx String
name VariableValue
val = do
(VariableProperties
props, Scope
scope) <- Ctx s -> String -> ST s (VariableProperties, Scope)
forall s. Ctx s -> String -> ST s (VariableProperties, Scope)
readVariablePropertiesWithScope Ctx s
ctx String
name
let f :: Ctx s -> String -> VariableState -> ST s ()
f = case Scope
scope of
Scope
GlobalScope -> Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeGlobal
Scope
LocalScope -> Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal
Scope
PrefixScope -> Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
f Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ VariableState :: VariableValue -> VariableProperties -> VariableState
VariableState { variableValue :: VariableValue
variableValue = VariableValue
val, variableProperties :: VariableProperties
variableProperties = VariableProperties
props }
updateGlobalValue :: Ctx s -> String -> VariableValue -> ST s ()
updateGlobalValue Ctx s
ctx String
name VariableValue
val = do
VariableProperties
props <- Ctx s -> String -> ST s VariableProperties
forall s. Ctx s -> String -> ST s VariableProperties
readGlobalProperties Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeGlobal Ctx s
ctx String
name VariableState :: VariableValue -> VariableProperties -> VariableState
VariableState { variableValue :: VariableValue
variableValue = VariableValue
val, variableProperties :: VariableProperties
variableProperties = VariableProperties
props }
updateLocalValue :: Ctx s -> String -> VariableValue -> ST s ()
updateLocalValue Ctx s
ctx String
name VariableValue
val = do
VariableProperties
props <- Ctx s -> String -> ST s VariableProperties
forall s. Ctx s -> String -> ST s VariableProperties
readLocalProperties Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name VariableState :: VariableValue -> VariableProperties -> VariableState
VariableState { variableValue :: VariableValue
variableValue = VariableValue
val, variableProperties :: VariableProperties
variableProperties = VariableProperties
props }
updatePrefixValue :: Ctx s -> String -> VariableValue -> ST s ()
updatePrefixValue Ctx s
ctx String
name VariableValue
val = do
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writePrefix Ctx s
ctx String
name VariableState :: VariableValue -> VariableProperties -> VariableState
VariableState { variableValue :: VariableValue
variableValue = VariableValue
val, variableProperties :: VariableProperties
variableProperties = VariableProperties
forall a. Set (Set a)
defaultProperties }
readVariableWithScope :: forall s. Ctx s -> String -> ST s (VariableState, Scope)
readVariableWithScope :: Ctx s -> String -> ST s (VariableState, Scope)
readVariableWithScope Ctx s
ctx String
name = (InternalState -> String -> Maybe (VariableState, Scope))
-> (String -> (VariableState, Scope) -> StateDependency)
-> (VariableState, Scope)
-> Ctx s
-> String
-> ST s (VariableState, Scope)
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> String -> Maybe (VariableState, Scope)
get String -> (VariableState, Scope) -> StateDependency
dep (VariableState, Scope)
def Ctx s
ctx String
name
where
def :: (VariableState, Scope)
def = (VariableState
unknownVariableState, Scope
GlobalScope)
get :: InternalState -> String -> Maybe (VariableState, Scope)
get = InternalState -> String -> Maybe (VariableState, Scope)
getVariableWithScope
dep :: String -> (VariableState, Scope) -> StateDependency
dep String
k (VariableState
val, Scope
scope) = Scope -> String -> VariableState -> StateDependency
DepState Scope
scope String
k VariableState
val
readVariablePropertiesWithScope :: forall s. Ctx s -> String -> ST s (VariableProperties, Scope)
readVariablePropertiesWithScope :: Ctx s -> String -> ST s (VariableProperties, Scope)
readVariablePropertiesWithScope Ctx s
ctx String
name = (InternalState -> String -> Maybe (VariableProperties, Scope))
-> (String -> (VariableProperties, Scope) -> StateDependency)
-> (VariableProperties, Scope)
-> Ctx s
-> String
-> ST s (VariableProperties, Scope)
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> String -> Maybe (VariableProperties, Scope)
get String -> (VariableProperties, Scope) -> StateDependency
dep (VariableProperties, Scope)
forall a. (Set (Set a), Scope)
def Ctx s
ctx String
name
where
def :: (Set (Set a), Scope)
def = (Set (Set a)
forall a. Set (Set a)
defaultProperties, Scope
GlobalScope)
get :: InternalState -> String -> Maybe (VariableProperties, Scope)
get InternalState
s String
k = do
(VariableState
val, Scope
scope) <- InternalState -> String -> Maybe (VariableState, Scope)
getVariableWithScope InternalState
s String
k
(VariableProperties, Scope) -> Maybe (VariableProperties, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableState -> VariableProperties
variableProperties VariableState
val, Scope
scope)
dep :: String -> (VariableProperties, Scope) -> StateDependency
dep String
k (VariableProperties
val, Scope
scope) = Scope -> String -> VariableProperties -> StateDependency
DepProperties Scope
scope String
k VariableProperties
val
readVariableScope :: Ctx s -> String -> ST s Scope
readVariableScope Ctx s
ctx String
name = (VariableProperties, Scope) -> Scope
forall a b. (a, b) -> b
snd ((VariableProperties, Scope) -> Scope)
-> ST s (VariableProperties, Scope) -> ST s Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx s -> String -> ST s (VariableProperties, Scope)
forall s. Ctx s -> String -> ST s (VariableProperties, Scope)
readVariablePropertiesWithScope Ctx s
ctx String
name
getVariableWithScope :: InternalState -> String -> Maybe (VariableState, Scope)
getVariableWithScope :: InternalState -> String -> Maybe (VariableState, Scope)
getVariableWithScope InternalState
s String
name =
case (String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
s, String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sLocalValues InternalState
s, String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
s) of
(Just VariableState
var, Maybe VariableState
_, Maybe VariableState
_) -> (VariableState, Scope) -> Maybe (VariableState, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableState
var, Scope
PrefixScope)
(Maybe VariableState
_, Just VariableState
var, Maybe VariableState
_) -> (VariableState, Scope) -> Maybe (VariableState, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableState
var, Scope
LocalScope)
(Maybe VariableState
_, Maybe VariableState
_, Just VariableState
var) -> (VariableState, Scope) -> Maybe (VariableState, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableState
var, Scope
GlobalScope)
(Maybe VariableState, Maybe VariableState, Maybe VariableState)
_ -> Maybe (VariableState, Scope)
forall a. Maybe a
Nothing
undefineFunction :: Ctx s -> String -> ST s ()
undefineFunction Ctx s
ctx String
name =
Ctx s -> String -> FunctionDefinition -> ST s ()
forall s. Ctx s -> String -> FunctionDefinition -> ST s ()
writeFunction Ctx s
ctx String
name (FunctionDefinition -> ST s ()) -> FunctionDefinition -> ST s ()
forall a b. (a -> b) -> a -> b
$ FunctionDefinition
FunctionUnknown
undefineVariable :: Ctx s -> String -> ST s ()
undefineVariable Ctx s
ctx String
name =
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeVariable Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ VariableState
unsetVariableState
readVariable :: Ctx s -> String -> ST s VariableState
readVariable Ctx s
ctx String
name = (VariableState, Scope) -> VariableState
forall a b. (a, b) -> a
fst ((VariableState, Scope) -> VariableState)
-> ST s (VariableState, Scope) -> ST s VariableState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx s -> String -> ST s (VariableState, Scope)
forall s. Ctx s -> String -> ST s (VariableState, Scope)
readVariableWithScope Ctx s
ctx String
name
readVariableProperties :: Ctx s -> String -> ST s VariableProperties
readVariableProperties Ctx s
ctx String
name = (VariableProperties, Scope) -> VariableProperties
forall a b. (a, b) -> a
fst ((VariableProperties, Scope) -> VariableProperties)
-> ST s (VariableProperties, Scope) -> ST s VariableProperties
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx s -> String -> ST s (VariableProperties, Scope)
forall s. Ctx s -> String -> ST s (VariableProperties, Scope)
readVariablePropertiesWithScope Ctx s
ctx String
name
readGlobal :: Ctx s -> String -> ST s VariableState
readGlobal Ctx s
ctx String
name = (InternalState -> String -> Maybe VariableState)
-> (String -> VariableState -> StateDependency)
-> VariableState
-> Ctx s
-> String
-> ST s VariableState
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> String -> Maybe VariableState
get String -> VariableState -> StateDependency
dep VariableState
def Ctx s
ctx String
name
where
def :: VariableState
def = VariableState
unknownVariableState
get :: InternalState -> String -> Maybe VariableState
get InternalState
s String
name = String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
s
dep :: String -> VariableState -> StateDependency
dep String
k VariableState
v = Scope -> String -> VariableState -> StateDependency
DepState Scope
GlobalScope String
k VariableState
v
readGlobalProperties :: Ctx s -> String -> ST s VariableProperties
readGlobalProperties Ctx s
ctx String
name = (InternalState -> String -> Maybe VariableProperties)
-> (String -> VariableProperties -> StateDependency)
-> VariableProperties
-> Ctx s
-> String
-> ST s VariableProperties
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> String -> Maybe VariableProperties
get String -> VariableProperties -> StateDependency
dep VariableProperties
forall a. Set (Set a)
def Ctx s
ctx String
name
where
def :: Set (Set a)
def = Set (Set a)
forall a. Set (Set a)
defaultProperties
get :: InternalState -> String -> Maybe VariableProperties
get InternalState
s String
name = VariableState -> VariableProperties
variableProperties (VariableState -> VariableProperties)
-> Maybe VariableState -> Maybe VariableProperties
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sGlobalValues InternalState
s)
dep :: String -> VariableProperties -> StateDependency
dep String
k VariableProperties
v = Scope -> String -> VariableProperties -> StateDependency
DepProperties Scope
GlobalScope String
k VariableProperties
v
readLocal :: Ctx s -> String -> ST s VariableState
readLocal Ctx s
ctx String
name = (InternalState -> String -> Maybe VariableState)
-> (String -> VariableState -> StateDependency)
-> VariableState
-> Ctx s
-> String
-> ST s VariableState
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStackUntilFunction InternalState -> String -> Maybe VariableState
get String -> VariableState -> StateDependency
dep VariableState
def Ctx s
ctx String
name
where
def :: VariableState
def = VariableState
unsetVariableState
get :: InternalState -> String -> Maybe VariableState
get InternalState
s String
name = String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sLocalValues InternalState
s
dep :: String -> VariableState -> StateDependency
dep String
k VariableState
v = Scope -> String -> VariableState -> StateDependency
DepState Scope
LocalScope String
k VariableState
v
readLocalProperties :: Ctx s -> String -> ST s VariableProperties
readLocalProperties Ctx s
ctx String
name = (VariableProperties, Scope) -> VariableProperties
forall a b. (a, b) -> a
fst ((VariableProperties, Scope) -> VariableProperties)
-> ST s (VariableProperties, Scope) -> ST s VariableProperties
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InternalState -> String -> Maybe (VariableProperties, Scope))
-> (String -> (VariableProperties, Scope) -> StateDependency)
-> (VariableProperties, Scope)
-> Ctx s
-> String
-> ST s (VariableProperties, Scope)
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStackUntilFunction InternalState -> String -> Maybe (VariableProperties, Scope)
get String -> (VariableProperties, Scope) -> StateDependency
dep (VariableProperties, Scope)
forall a. (Set (Set a), Scope)
def Ctx s
ctx String
name
where
def :: (Set (Set a), Scope)
def = (Set (Set a)
forall a. Set (Set a)
defaultProperties, Scope
LocalScope)
with :: b -> m VariableState -> m (VariableProperties, b)
with b
tag m VariableState
f = do
VariableProperties
val <- VariableState -> VariableProperties
variableProperties (VariableState -> VariableProperties)
-> m VariableState -> m VariableProperties
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m VariableState
f
(VariableProperties, b) -> m (VariableProperties, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableProperties
val, b
tag)
get :: InternalState -> String -> Maybe (VariableProperties, Scope)
get InternalState
s String
name = (Scope -> Maybe VariableState -> Maybe (VariableProperties, Scope)
forall (m :: * -> *) b.
Monad m =>
b -> m VariableState -> m (VariableProperties, b)
with Scope
LocalScope (Maybe VariableState -> Maybe (VariableProperties, Scope))
-> Maybe VariableState -> Maybe (VariableProperties, Scope)
forall a b. (a -> b) -> a -> b
$ String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sLocalValues InternalState
s) Maybe (VariableProperties, Scope)
-> Maybe (VariableProperties, Scope)
-> Maybe (VariableProperties, Scope)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Scope -> Maybe VariableState -> Maybe (VariableProperties, Scope)
forall (m :: * -> *) b.
Monad m =>
b -> m VariableState -> m (VariableProperties, b)
with Scope
PrefixScope (Maybe VariableState -> Maybe (VariableProperties, Scope))
-> Maybe VariableState -> Maybe (VariableProperties, Scope)
forall a b. (a -> b) -> a -> b
$ String -> VersionedMap String VariableState -> Maybe VariableState
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String VariableState -> Maybe VariableState)
-> VersionedMap String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String VariableState
sPrefixValues InternalState
s)
dep :: String -> (VariableProperties, Scope) -> StateDependency
dep String
k (VariableProperties
val, Scope
scope) = Scope -> String -> VariableProperties -> StateDependency
DepProperties Scope
scope String
k VariableProperties
val
readFunction :: Ctx s -> String -> ST s FunctionValue
readFunction Ctx s
ctx String
name = (InternalState -> String -> Maybe FunctionValue)
-> (String -> FunctionValue -> StateDependency)
-> FunctionValue
-> Ctx s
-> String
-> ST s FunctionValue
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> String -> Maybe FunctionValue
get String -> FunctionValue -> StateDependency
dep FunctionValue
def Ctx s
ctx String
name
where
def :: FunctionValue
def = FunctionValue
unknownFunctionValue
get :: InternalState -> String -> Maybe FunctionValue
get InternalState
s String
name = String -> VersionedMap String FunctionValue -> Maybe FunctionValue
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String FunctionValue -> Maybe FunctionValue)
-> VersionedMap String FunctionValue -> Maybe FunctionValue
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
s
dep :: String -> FunctionValue -> StateDependency
dep String
k FunctionValue
v = String -> FunctionValue -> StateDependency
DepFunction String
k FunctionValue
v
writeFunction :: Ctx s -> String -> FunctionDefinition -> ST s ()
writeFunction Ctx s
ctx String
name FunctionDefinition
val = do
STRef s InternalState
-> (InternalState -> InternalState) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) ((InternalState -> InternalState) -> ST s ())
-> (InternalState -> InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> FunctionValue -> InternalState -> InternalState
insertFunction String
name (FunctionValue -> InternalState -> InternalState)
-> FunctionValue -> InternalState -> InternalState
forall a b. (a -> b) -> a -> b
$ FunctionDefinition -> FunctionValue
forall a. a -> Set a
S.singleton FunctionDefinition
val
readExitCodes :: Ctx s -> ST s (Set Id)
readExitCodes Ctx s
ctx = (InternalState -> () -> Maybe (Set Id))
-> (() -> Set Id -> StateDependency)
-> Set Id
-> Ctx s
-> ()
-> ST s (Set Id)
forall k v s.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> () -> Maybe (Set Id)
get () -> Set Id -> StateDependency
dep Set Id
forall a. Set a
def Ctx s
ctx ()
where
get :: InternalState -> () -> Maybe (Set Id)
get InternalState
s () = InternalState -> Maybe (Set Id)
sExitCodes InternalState
s
def :: Set a
def = Set a
forall a. Set a
S.empty
dep :: () -> Set Id -> StateDependency
dep () Set Id
v = Set Id -> StateDependency
DepExitCodes Set Id
v
lookupStack' :: forall s k v.
Bool
-> (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency)
-> v
-> Ctx s
-> k
-> ST s v
lookupStack' :: Bool
-> (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency)
-> v
-> Ctx s
-> k
-> ST s v
lookupStack' Bool
functionOnly InternalState -> k -> Maybe v
get k -> v -> StateDependency
dep v
def Ctx s
ctx k
key = do
InternalState
top <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef (STRef s InternalState -> ST s InternalState)
-> STRef s InternalState -> ST s InternalState
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cInput Ctx s
ctx
case InternalState -> k -> Maybe v
get InternalState
top k
key of
Just v
v -> v -> ST s v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
Maybe v
Nothing -> [StackEntry s] -> ST s v
forall s. [StackEntry s] -> ST s v
f (Ctx s -> [StackEntry s]
forall s. Ctx s -> [StackEntry s]
cStack Ctx s
ctx)
where
f :: [StackEntry s] -> ST s v
f [] = v -> ST s v
forall (m :: * -> *) a. Monad m => a -> m a
return v
def
f (StackEntry s
s:[StackEntry s]
_) | Bool
functionOnly Bool -> Bool -> Bool
&& StackEntry s -> Bool
forall s. StackEntry s -> Bool
isFunctionCall StackEntry s
s = v -> ST s v
forall (m :: * -> *) a. Monad m => a -> m a
return v
def
f (StackEntry s
s:[StackEntry s]
rest) = do
v
res <- ST s v -> Maybe (ST s v) -> ST s v
forall a. a -> Maybe a -> a
fromMaybe ([StackEntry s] -> ST s v
f [StackEntry s]
rest) (v -> ST s v
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> ST s v) -> Maybe v -> Maybe (ST s v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InternalState -> k -> Maybe v
get (StackEntry s -> InternalState
forall s. StackEntry s -> InternalState
stackState StackEntry s
s) k
key)
STRef s (Set StateDependency)
-> (Set StateDependency -> Set StateDependency) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (StackEntry s -> STRef s (Set StateDependency)
forall s. StackEntry s -> STRef s (Set StateDependency)
dependencies StackEntry s
s) ((Set StateDependency -> Set StateDependency) -> ST s ())
-> (Set StateDependency -> Set StateDependency) -> ST s ()
forall a b. (a -> b) -> a -> b
$ StateDependency -> Set StateDependency -> Set StateDependency
forall a. Ord a => a -> Set a -> Set a
S.insert (StateDependency -> Set StateDependency -> Set StateDependency)
-> StateDependency -> Set StateDependency -> Set StateDependency
forall a b. (a -> b) -> a -> b
$ k -> v -> StateDependency
dep k
key v
res
v -> ST s v
forall (m :: * -> *) a. Monad m => a -> m a
return v
res
lookupStack :: (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack = Bool
-> (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency)
-> v
-> Ctx s
-> k
-> ST s v
forall s k v.
Bool
-> (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency)
-> v
-> Ctx s
-> k
-> ST s v
lookupStack' Bool
False
lookupStackUntilFunction :: (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStackUntilFunction = Bool
-> (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency)
-> v
-> Ctx s
-> k
-> ST s v
forall s k v.
Bool
-> (InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency)
-> v
-> Ctx s
-> k
-> ST s v
lookupStack' Bool
True
peekStack :: (InternalState -> t -> Maybe b) -> b -> Ctx s -> t -> ST s b
peekStack InternalState -> t -> Maybe b
get b
def Ctx s
ctx t
key = do
InternalState
top <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef (STRef s InternalState -> ST s InternalState)
-> STRef s InternalState -> ST s InternalState
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cInput Ctx s
ctx
case InternalState -> t -> Maybe b
get InternalState
top t
key of
Just b
v -> b -> ST s b
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
Maybe b
Nothing -> [StackEntry s] -> ST s b
forall (m :: * -> *) s. Monad m => [StackEntry s] -> m b
f (Ctx s -> [StackEntry s]
forall s. Ctx s -> [StackEntry s]
cStack Ctx s
ctx)
where
f :: [StackEntry s] -> m b
f [] = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
def
f (StackEntry s
s:[StackEntry s]
rest) =
case InternalState -> t -> Maybe b
get (StackEntry s -> InternalState
forall s. StackEntry s -> InternalState
stackState StackEntry s
s) t
key of
Just b
v -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
Maybe b
Nothing -> [StackEntry s] -> m b
f [StackEntry s]
rest
fulfillsDependency :: Ctx s -> Int -> StateDependency -> ST s Bool
fulfillsDependency Ctx s
ctx Int
entry StateDependency
dep =
case StateDependency
dep of
DepState Scope
scope String
name VariableState
val -> ((VariableState, Scope) -> (VariableState, Scope) -> Bool
forall a. Eq a => a -> a -> Bool
== (VariableState
val, Scope
scope)) ((VariableState, Scope) -> Bool)
-> ST s (VariableState, Scope) -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scope -> Ctx s -> String -> ST s (VariableState, Scope)
forall s. Scope -> Ctx s -> String -> ST s (VariableState, Scope)
peek Scope
scope Ctx s
ctx String
name
DepProperties Scope
scope String
name VariableProperties
props -> do
(VariableState
state, Scope
s) <- Scope -> Ctx s -> String -> ST s (VariableState, Scope)
forall s. Scope -> Ctx s -> String -> ST s (VariableState, Scope)
peek Scope
scope Ctx s
ctx String
name
Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ST s Bool) -> Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Scope
scope Scope -> Scope -> Bool
forall a. Eq a => a -> a -> Bool
== Scope
s Bool -> Bool -> Bool
&& VariableState -> VariableProperties
variableProperties VariableState
state VariableProperties -> VariableProperties -> Bool
forall a. Eq a => a -> a -> Bool
== VariableProperties
props
DepFunction String
name FunctionValue
val -> (FunctionValue -> FunctionValue -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionValue
val) (FunctionValue -> Bool) -> ST s FunctionValue -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx s -> String -> ST s FunctionValue
forall s. Ctx s -> String -> ST s FunctionValue
peekFunc Ctx s
ctx String
name
DepIsRecursive Int
node Bool
val | Int
node Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
entry -> Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
DepIsRecursive Int
node Bool
val -> Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ST s Bool) -> Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Bool
val Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (StackEntry s -> Bool) -> [StackEntry s] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\StackEntry s
f -> StackEntry s -> Int
forall s. StackEntry s -> Int
entryPoint StackEntry s
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
node) (Ctx s -> [StackEntry s]
forall s. Ctx s -> [StackEntry s]
cStack Ctx s
ctx)
DepExitCodes Set Id
val -> (Set Id -> Set Id -> Bool
forall a. Eq a => a -> a -> Bool
== Set Id
val) (Set Id -> Bool) -> ST s (Set Id) -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InternalState -> () -> Maybe (Set Id))
-> Set Id -> Ctx s -> () -> ST s (Set Id)
forall t b s.
(InternalState -> t -> Maybe b) -> b -> Ctx s -> t -> ST s b
peekStack (\InternalState
s ()
k -> InternalState -> Maybe (Set Id)
sExitCodes InternalState
s) Set Id
forall a. Set a
S.empty Ctx s
ctx ()
where
peek :: Scope -> Ctx s -> String -> ST s (VariableState, Scope)
peek Scope
scope = (InternalState -> String -> Maybe (VariableState, Scope))
-> (VariableState, Scope)
-> Ctx s
-> String
-> ST s (VariableState, Scope)
forall t b s.
(InternalState -> t -> Maybe b) -> b -> Ctx s -> t -> ST s b
peekStack InternalState -> String -> Maybe (VariableState, Scope)
getVariableWithScope ((VariableState, Scope)
-> Ctx s -> String -> ST s (VariableState, Scope))
-> (VariableState, Scope)
-> Ctx s
-> String
-> ST s (VariableState, Scope)
forall a b. (a -> b) -> a -> b
$ if Scope
scope Scope -> Scope -> Bool
forall a. Eq a => a -> a -> Bool
== Scope
GlobalScope then (VariableState
unknownVariableState, Scope
GlobalScope) else (VariableState
unsetVariableState, Scope
LocalScope)
peekFunc :: Ctx s -> String -> ST s FunctionValue
peekFunc = (InternalState -> String -> Maybe FunctionValue)
-> FunctionValue -> Ctx s -> String -> ST s FunctionValue
forall t b s.
(InternalState -> t -> Maybe b) -> b -> Ctx s -> t -> ST s b
peekStack (\InternalState
state String
name -> String -> VersionedMap String FunctionValue -> Maybe FunctionValue
forall k a. Ord k => k -> VersionedMap k a -> Maybe a
vmLookup String
name (VersionedMap String FunctionValue -> Maybe FunctionValue)
-> VersionedMap String FunctionValue -> Maybe FunctionValue
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
state) FunctionValue
unknownFunctionValue
fulfillsDependencies :: Ctx s -> Int -> Set StateDependency -> ST s Bool
fulfillsDependencies Ctx s
ctx Int
entry Set StateDependency
deps =
[StateDependency] -> ST s Bool
f ([StateDependency] -> ST s Bool) -> [StateDependency] -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Set StateDependency -> [StateDependency]
forall a. Set a -> [a]
S.toList Set StateDependency
deps
where
f :: [StateDependency] -> ST s Bool
f [] = Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
f (StateDependency
dep:[StateDependency]
rest) = do
Bool
res <- Ctx s -> Int -> StateDependency -> ST s Bool
forall s. Ctx s -> Int -> StateDependency -> ST s Bool
fulfillsDependency Ctx s
ctx Int
entry StateDependency
dep
if Bool
res
then [StateDependency] -> ST s Bool
f [StateDependency]
rest
else Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
newCtx :: CFGraph -> ST s (Ctx s)
newCtx CFGraph
g = do
STRef s Integer
c <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
1
STRef s InternalState
input <- InternalState -> ST s (STRef s InternalState)
forall a s. a -> ST s (STRef s a)
newSTRef InternalState
forall a. HasCallStack => a
undefined
STRef s InternalState
output <- InternalState -> ST s (STRef s InternalState)
forall a s. a -> ST s (STRef s a)
newSTRef InternalState
forall a. HasCallStack => a
undefined
STRef s Int
node <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
forall a. HasCallStack => a
undefined
STRef s (Map Int [(Set StateDependency, InternalState)])
cache <- Map Int [(Set StateDependency, InternalState)]
-> ST s (STRef s (Map Int [(Set StateDependency, InternalState)]))
forall a s. a -> ST s (STRef s a)
newSTRef Map Int [(Set StateDependency, InternalState)]
forall k a. Map k a
M.empty
STRef s Bool
enableCache <- Bool -> ST s (STRef s Bool)
forall a s. a -> ST s (STRef s a)
newSTRef Bool
True
STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
invocations <- Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
-> ST
s
(STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState))))
forall a s. a -> ST s (STRef s a)
newSTRef Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
forall k a. Map k a
M.empty
Ctx s -> ST s (Ctx s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ctx s -> ST s (Ctx s)) -> Ctx s -> ST s (Ctx s)
forall a b. (a -> b) -> a -> b
$ Ctx :: forall s.
STRef s Int
-> STRef s InternalState
-> STRef s InternalState
-> [StackEntry s]
-> CFGraph
-> STRef s Integer
-> STRef s (Map Int [(Set StateDependency, InternalState)])
-> STRef s Bool
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> Ctx s
Ctx {
cCounter :: STRef s Integer
cCounter = STRef s Integer
c,
cInput :: STRef s InternalState
cInput = STRef s InternalState
input,
cOutput :: STRef s InternalState
cOutput = STRef s InternalState
output,
cNode :: STRef s Int
cNode = STRef s Int
node,
cCache :: STRef s (Map Int [(Set StateDependency, InternalState)])
cCache = STRef s (Map Int [(Set StateDependency, InternalState)])
cache,
cEnableCache :: STRef s Bool
cEnableCache = STRef s Bool
enableCache,
cStack :: [StackEntry s]
cStack = [],
cInvocations :: STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
cInvocations = STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
invocations,
cGraph :: CFGraph
cGraph = CFGraph
g
}
nextVersion :: Ctx s -> ST s Integer
nextVersion Ctx s
ctx = do
let ctr :: STRef s Integer
ctr = Ctx s -> STRef s Integer
forall s. Ctx s -> STRef s Integer
cCounter Ctx s
ctx
Integer
n <- STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
ctr
STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
ctr (Integer -> ST s ()) -> Integer -> ST s ()
forall a b. (a -> b) -> a -> b
$! Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1
Integer -> ST s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n
newStackEntry :: Ctx s -> Int -> Bool -> ST s (StackEntry s)
newStackEntry Ctx s
ctx Int
point Bool
isCall = do
STRef s (Set StateDependency)
deps <- Set StateDependency -> ST s (STRef s (Set StateDependency))
forall a s. a -> ST s (STRef s a)
newSTRef Set StateDependency
forall a. Set a
S.empty
InternalState
state <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef (STRef s InternalState -> ST s InternalState)
-> STRef s InternalState -> ST s InternalState
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx
Int
callsite <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s Int
forall s. Ctx s -> STRef s Int
cNode Ctx s
ctx
StackEntry s -> ST s (StackEntry s)
forall (m :: * -> *) a. Monad m => a -> m a
return (StackEntry s -> ST s (StackEntry s))
-> StackEntry s -> ST s (StackEntry s)
forall a b. (a -> b) -> a -> b
$ StackEntry :: forall s.
Int
-> Bool
-> Int
-> STRef s (Set StateDependency)
-> InternalState
-> StackEntry s
StackEntry {
entryPoint :: Int
entryPoint = Int
point,
isFunctionCall :: Bool
isFunctionCall = Bool
isCall,
callSite :: Int
callSite = Int
callsite,
dependencies :: STRef s (Set StateDependency)
dependencies = STRef s (Set StateDependency)
deps,
stackState :: InternalState
stackState = InternalState
state
}
withNewStackFrame :: Ctx s -> Int -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Int
node Bool
isCall Ctx s -> ST s a
f = do
StackEntry s
newEntry <- Ctx s -> Int -> Bool -> ST s (StackEntry s)
forall s. Ctx s -> Int -> Bool -> ST s (StackEntry s)
newStackEntry Ctx s
ctx Int
node Bool
isCall
STRef s InternalState
newInput <- InternalState -> ST s (STRef s InternalState)
forall a s. a -> ST s (STRef s a)
newSTRef InternalState
newInternalState
STRef s InternalState
newOutput <- InternalState -> ST s (STRef s InternalState)
forall a s. a -> ST s (STRef s a)
newSTRef InternalState
newInternalState
STRef s Int
newNode <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
node
let newCtx :: Ctx s
newCtx = Ctx s
ctx {
cInput :: STRef s InternalState
cInput = STRef s InternalState
newInput,
cOutput :: STRef s InternalState
cOutput = STRef s InternalState
newOutput,
cNode :: STRef s Int
cNode = STRef s Int
newNode,
cStack :: [StackEntry s]
cStack = StackEntry s
newEntry StackEntry s -> [StackEntry s] -> [StackEntry s]
forall a. a -> [a] -> [a]
: Ctx s -> [StackEntry s]
forall s. Ctx s -> [StackEntry s]
cStack Ctx s
ctx
}
a
x <- Ctx s -> ST s a
f Ctx s
newCtx
(a, StackEntry s) -> ST s (a, StackEntry s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, StackEntry s
newEntry)
wouldBeRecursive :: Ctx s -> Int -> ST s Bool
wouldBeRecursive Ctx s
ctx Int
node = [StackEntry s] -> ST s Bool
forall s. [StackEntry s] -> ST s Bool
f (Ctx s -> [StackEntry s]
forall s. Ctx s -> [StackEntry s]
cStack Ctx s
ctx)
where
f :: [StackEntry s] -> ST s Bool
f [] = Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
f (StackEntry s
s:[StackEntry s]
rest) = do
Bool
res <-
if StackEntry s -> Int
forall s. StackEntry s -> Int
entryPoint StackEntry s
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
node
then Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else [StackEntry s] -> ST s Bool
f [StackEntry s]
rest
STRef s (Set StateDependency)
-> (Set StateDependency -> Set StateDependency) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (StackEntry s -> STRef s (Set StateDependency)
forall s. StackEntry s -> STRef s (Set StateDependency)
dependencies StackEntry s
s) ((Set StateDependency -> Set StateDependency) -> ST s ())
-> (Set StateDependency -> Set StateDependency) -> ST s ()
forall a b. (a -> b) -> a -> b
$ StateDependency -> Set StateDependency -> Set StateDependency
forall a. Ord a => a -> Set a -> Set a
S.insert (StateDependency -> Set StateDependency -> Set StateDependency)
-> StateDependency -> Set StateDependency -> Set StateDependency
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> StateDependency
DepIsRecursive Int
node Bool
res
Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
res
transfer :: Ctx s -> CFNode -> ST s ()
transfer Ctx s
ctx CFNode
label =
case CFNode
label of
CFNode
CFStructuralNode -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CFEntryPoint String
_ -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CFNode
CFImpliedExit -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CFResolvedExit {} -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CFExecuteCommand Maybe String
cmd -> Ctx s -> Maybe String -> ST s ()
forall s. Ctx s -> Maybe String -> ST s ()
transferCommand Ctx s
ctx Maybe String
cmd
CFExecuteSubshell String
reason Int
entry Int
exit -> Ctx s -> String -> Int -> Int -> ST s ()
forall s p. Ctx s -> p -> Int -> Int -> ST s ()
transferSubshell Ctx s
ctx String
reason Int
entry Int
exit
CFApplyEffects [IdTagged CFEffect]
effects -> (IdTagged CFEffect -> ST s ()) -> [IdTagged CFEffect] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(IdTagged Id
_ CFEffect
f) -> Ctx s -> CFEffect -> ST s ()
forall s. Ctx s -> CFEffect -> ST s ()
transferEffect Ctx s
ctx CFEffect
f) [IdTagged CFEffect]
effects
CFSetExitCode Id
id -> Ctx s -> Id -> ST s ()
forall s. Ctx s -> Id -> ST s ()
transferExitCode Ctx s
ctx Id
id
CFNode
CFUnresolvedExit -> Ctx s -> InternalState -> ST s ()
forall s. Ctx s -> InternalState -> ST s ()
patchOutputM Ctx s
ctx InternalState
unreachableState
CFNode
CFUnreachable -> Ctx s -> InternalState -> ST s ()
forall s. Ctx s -> InternalState -> ST s ()
patchOutputM Ctx s
ctx InternalState
unreachableState
CFSetBackgroundPid Id
_ -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CFDropPrefixAssignments {} ->
STRef s InternalState
-> (InternalState -> InternalState) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) ((InternalState -> InternalState) -> ST s ())
-> (InternalState -> InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \InternalState
c -> InternalState -> InternalState
modified InternalState
c { sPrefixValues :: VersionedMap String VariableState
sPrefixValues = VersionedMap String VariableState
forall k v. VersionedMap k v
vmEmpty }
transferSubshell :: Ctx s -> p -> Int -> Int -> ST s ()
transferSubshell Ctx s
ctx p
reason Int
entry Int
exit = do
let cout :: STRef s InternalState
cout = Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx
InternalState
initial <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
cout
Ctx s
-> Int
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
forall s.
Ctx s
-> Int
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
runCached Ctx s
ctx Int
entry (Int -> Int -> Ctx s -> ST s (Set StateDependency, InternalState)
forall s.
Int -> Int -> Ctx s -> ST s (Set StateDependency, InternalState)
f Int
entry Int
exit)
InternalState
res <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
cout
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
cout (InternalState -> ST s ()) -> InternalState -> ST s ()
forall a b. (a -> b) -> a -> b
$ InternalState
initial {
sExitCodes :: Maybe (Set Id)
sExitCodes = InternalState -> Maybe (Set Id)
sExitCodes InternalState
res
}
where
f :: Int -> Int -> Ctx s -> ST s (Set StateDependency, InternalState)
f Int
entry Int
exit Ctx s
ctx = do
(Map Int (InternalState, InternalState)
states, StackEntry s
frame) <- Ctx s
-> Int
-> Bool
-> (Ctx s -> ST s (Map Int (InternalState, InternalState)))
-> ST s (Map Int (InternalState, InternalState), StackEntry s)
forall s a.
Ctx s -> Int -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Int
entry Bool
False ((Ctx s -> Int -> ST s (Map Int (InternalState, InternalState)))
-> Int -> Ctx s -> ST s (Map Int (InternalState, InternalState))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ctx s -> Int -> ST s (Map Int (InternalState, InternalState))
forall s.
Ctx s -> Int -> ST s (Map Int (InternalState, InternalState))
dataflow (Int -> Ctx s -> ST s (Map Int (InternalState, InternalState)))
-> Int -> Ctx s -> ST s (Map Int (InternalState, InternalState))
forall a b. (a -> b) -> a -> b
$ Int
entry)
let (InternalState
_, InternalState
res) = (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
-> (InternalState, InternalState)
forall a. a -> Maybe a -> a
fromMaybe (String -> (InternalState, InternalState)
forall a. HasCallStack => String -> a
error (String -> (InternalState, InternalState))
-> String -> (InternalState, InternalState)
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Subshell has no exit") (Maybe (InternalState, InternalState)
-> (InternalState, InternalState))
-> Maybe (InternalState, InternalState)
-> (InternalState, InternalState)
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
exit Map Int (InternalState, InternalState)
states
Set StateDependency
deps <- STRef s (Set StateDependency) -> ST s (Set StateDependency)
forall s a. STRef s a -> ST s a
readSTRef (STRef s (Set StateDependency) -> ST s (Set StateDependency))
-> STRef s (Set StateDependency) -> ST s (Set StateDependency)
forall a b. (a -> b) -> a -> b
$ StackEntry s -> STRef s (Set StateDependency)
forall s. StackEntry s -> STRef s (Set StateDependency)
dependencies StackEntry s
frame
Ctx s
-> Int
-> Map Int (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
forall s.
Ctx s
-> Int
-> Map Int (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Int
entry Map Int (InternalState, InternalState)
states Set StateDependency
deps
(Set StateDependency, InternalState)
-> ST s (Set StateDependency, InternalState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set StateDependency
deps, InternalState
res)
transferCommand :: Ctx s -> Maybe String -> ST s ()
transferCommand Ctx s
ctx Maybe String
Nothing = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
transferCommand Ctx s
ctx (Just String
name) = do
FunctionValue
targets <- Ctx s -> String -> ST s FunctionValue
forall s. Ctx s -> String -> ST s FunctionValue
readFunction Ctx s
ctx String
name
(String, String, FunctionValue) -> ST s ()
forall (m :: * -> *) p. Monad m => p -> m ()
logVerbose (String
"Transferring ",String
name,FunctionValue
targets)
Ctx s -> [Ctx s -> ST s ()] -> ST s ()
forall s a. Ctx s -> [Ctx s -> ST s a] -> ST s ()
transferMultiple Ctx s
ctx ([Ctx s -> ST s ()] -> ST s ()) -> [Ctx s -> ST s ()] -> ST s ()
forall a b. (a -> b) -> a -> b
$ (FunctionDefinition -> Ctx s -> ST s ())
-> [FunctionDefinition] -> [Ctx s -> ST s ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Ctx s -> FunctionDefinition -> ST s ())
-> FunctionDefinition -> Ctx s -> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ctx s -> FunctionDefinition -> ST s ()
forall s. Ctx s -> FunctionDefinition -> ST s ()
transferFunctionValue) ([FunctionDefinition] -> [Ctx s -> ST s ()])
-> [FunctionDefinition] -> [Ctx s -> ST s ()]
forall a b. (a -> b) -> a -> b
$ FunctionValue -> [FunctionDefinition]
forall a. Set a -> [a]
S.toList FunctionValue
targets
transferMultiple :: Ctx s -> [Ctx s -> ST s a] -> ST s ()
transferMultiple Ctx s
ctx [Ctx s -> ST s a]
funcs = do
(String, Int) -> ST s ()
forall (m :: * -> *) p. Monad m => p -> m ()
logVerbose (String
"Transferring set of ", [Ctx s -> ST s a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ctx s -> ST s a]
funcs)
InternalState
original <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
out
[InternalState]
branches <- ((Ctx s -> ST s a) -> ST s InternalState)
-> [Ctx s -> ST s a] -> ST s [InternalState]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ctx s -> InternalState -> (Ctx s -> ST s a) -> ST s InternalState
forall t a.
t -> InternalState -> (t -> ST s a) -> ST s InternalState
apply Ctx s
ctx InternalState
original) [Ctx s -> ST s a]
funcs
InternalState
merged <- Ctx s -> InternalState -> [InternalState] -> ST s InternalState
forall s.
Ctx s -> InternalState -> [InternalState] -> ST s InternalState
mergeStates Ctx s
ctx InternalState
original [InternalState]
branches
let patched :: InternalState
patched = InternalState -> InternalState -> InternalState
patchState InternalState
original InternalState
merged
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
out InternalState
patched
where
out :: STRef s InternalState
out = Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx
apply :: t -> InternalState -> (t -> ST s a) -> ST s InternalState
apply t
ctx InternalState
original t -> ST s a
f = do
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
out InternalState
original
t -> ST s a
f t
ctx
STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
out
transferFunctionValue :: Ctx s -> FunctionDefinition -> ST s ()
transferFunctionValue Ctx s
ctx FunctionDefinition
funcVal =
case FunctionDefinition
funcVal of
FunctionDefinition
FunctionUnknown -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FunctionDefinition String
name Int
entry Int
exit -> do
Bool
isRecursive <- Ctx s -> Int -> ST s Bool
forall s. Ctx s -> Int -> ST s Bool
wouldBeRecursive Ctx s
ctx Int
entry
if Bool
isRecursive
then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Ctx s
-> Int
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
forall s.
Ctx s
-> Int
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
runCached Ctx s
ctx Int
entry (String
-> Int -> Int -> Ctx s -> ST s (Set StateDependency, InternalState)
forall p s.
p
-> Int -> Int -> Ctx s -> ST s (Set StateDependency, InternalState)
f String
name Int
entry Int
exit)
where
f :: p
-> Int -> Int -> Ctx s -> ST s (Set StateDependency, InternalState)
f p
name Int
entry Int
exit Ctx s
ctx = do
(Map Int (InternalState, InternalState)
states, StackEntry s
frame) <- Ctx s
-> Int
-> Bool
-> (Ctx s -> ST s (Map Int (InternalState, InternalState)))
-> ST s (Map Int (InternalState, InternalState), StackEntry s)
forall s a.
Ctx s -> Int -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Int
entry Bool
True ((Ctx s -> Int -> ST s (Map Int (InternalState, InternalState)))
-> Int -> Ctx s -> ST s (Map Int (InternalState, InternalState))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ctx s -> Int -> ST s (Map Int (InternalState, InternalState))
forall s.
Ctx s -> Int -> ST s (Map Int (InternalState, InternalState))
dataflow (Int -> Ctx s -> ST s (Map Int (InternalState, InternalState)))
-> Int -> Ctx s -> ST s (Map Int (InternalState, InternalState))
forall a b. (a -> b) -> a -> b
$ Int
entry)
Set StateDependency
deps <- STRef s (Set StateDependency) -> ST s (Set StateDependency)
forall s a. STRef s a -> ST s a
readSTRef (STRef s (Set StateDependency) -> ST s (Set StateDependency))
-> STRef s (Set StateDependency) -> ST s (Set StateDependency)
forall a b. (a -> b) -> a -> b
$ StackEntry s -> STRef s (Set StateDependency)
forall s. StackEntry s -> STRef s (Set StateDependency)
dependencies StackEntry s
frame
let res :: InternalState
res =
case Int
-> Map Int (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
exit Map Int (InternalState, InternalState)
states of
Just (InternalState
input, InternalState
output) -> do
InternalState -> InternalState
modified InternalState
output { sLocalValues :: VersionedMap String VariableState
sLocalValues = VersionedMap String VariableState
forall k v. VersionedMap k v
vmEmpty }
Maybe (InternalState, InternalState)
Nothing -> do
InternalState
unreachableState
Ctx s
-> Int
-> Map Int (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
forall s.
Ctx s
-> Int
-> Map Int (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Int
entry Map Int (InternalState, InternalState)
states Set StateDependency
deps
(Set StateDependency, InternalState)
-> ST s (Set StateDependency, InternalState)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set StateDependency
deps, InternalState
res)
transferExitCode :: Ctx s -> Id -> ST s ()
transferExitCode Ctx s
ctx Id
id = do
STRef s InternalState
-> (InternalState -> InternalState) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) ((InternalState -> InternalState) -> ST s ())
-> (InternalState -> InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Id -> InternalState -> InternalState
setExitCode Id
id
registerFlowResult :: Ctx s
-> Int
-> Map Int (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Int
entry Map Int (InternalState, InternalState)
states Set StateDependency
deps = do
Int
current <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (STRef s Int -> ST s Int) -> STRef s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s Int
forall s. Ctx s -> STRef s Int
cNode Ctx s
ctx
let parents :: [Int]
parents = (StackEntry s -> Int) -> [StackEntry s] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map StackEntry s -> Int
forall s. StackEntry s -> Int
callSite ([StackEntry s] -> [Int]) -> [StackEntry s] -> [Int]
forall a b. (a -> b) -> a -> b
$ Ctx s -> [StackEntry s]
forall s. Ctx s -> [StackEntry s]
cStack Ctx s
ctx
let path :: [Int]
path = Int
entry Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int
current Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
parents
STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> (Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
-> Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
forall s.
Ctx s
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
cInvocations Ctx s
ctx) ((Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
-> Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST s ())
-> (Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
-> Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ [Int]
-> (Set StateDependency, Map Int (InternalState, InternalState))
-> Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
-> Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert [Int]
path (Set StateDependency
deps, Map Int (InternalState, InternalState)
states)
runCached :: forall s. Ctx s -> Node -> (Ctx s -> ST s (S.Set StateDependency, InternalState)) -> ST s ()
runCached :: Ctx s
-> Int
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
runCached Ctx s
ctx Int
node Ctx s -> ST s (Set StateDependency, InternalState)
f = do
Maybe InternalState
cache <- Ctx s -> Int -> ST s (Maybe InternalState)
forall s. Ctx s -> Int -> ST s (Maybe InternalState)
getCache Ctx s
ctx Int
node
case Maybe InternalState
cache of
Just InternalState
v -> do
(String, Int) -> ST s ()
forall (m :: * -> *) p. Monad m => p -> m ()
logInfo (String
"Running cached", Int
node)
Ctx s -> InternalState -> ST s ()
forall s. Ctx s -> InternalState -> ST s ()
patchOutputM Ctx s
ctx InternalState
v
Maybe InternalState
Nothing -> do
(String, Int) -> ST s ()
forall (m :: * -> *) p. Monad m => p -> m ()
logInfo (String
"Cache failed", Int
node)
(Set StateDependency
deps, InternalState
diff) <- Ctx s -> ST s (Set StateDependency, InternalState)
f Ctx s
ctx
STRef s (Map Int [(Set StateDependency, InternalState)])
-> (Map Int [(Set StateDependency, InternalState)]
-> Map Int [(Set StateDependency, InternalState)])
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s (Map Int [(Set StateDependency, InternalState)])
forall s.
Ctx s -> STRef s (Map Int [(Set StateDependency, InternalState)])
cCache Ctx s
ctx) (([(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)])
-> Int
-> [(Set StateDependency, InternalState)]
-> Map Int [(Set StateDependency, InternalState)]
-> Map Int [(Set StateDependency, InternalState)]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\[(Set StateDependency, InternalState)]
_ [(Set StateDependency, InternalState)]
old -> (Set StateDependency
deps, InternalState
diff)(Set StateDependency, InternalState)
-> [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
forall a. a -> [a] -> [a]
:(Int
-> [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
forall a. Int -> [a] -> [a]
take Int
cacheEntries [(Set StateDependency, InternalState)]
old)) Int
node [(Set StateDependency
deps,InternalState
diff)])
(String, Int, Set StateDependency) -> ST s ()
forall (m :: * -> *) p. Monad m => p -> m ()
logVerbose (String
"Recomputed cache for", Int
node, Set StateDependency
deps)
Ctx s -> InternalState -> ST s ()
forall s. Ctx s -> InternalState -> ST s ()
patchOutputM Ctx s
ctx InternalState
diff
getCache :: forall s. Ctx s -> Node -> ST s (Maybe InternalState)
getCache :: Ctx s -> Int -> ST s (Maybe InternalState)
getCache Ctx s
ctx Int
node = do
Map Int [(Set StateDependency, InternalState)]
cache <- STRef s (Map Int [(Set StateDependency, InternalState)])
-> ST s (Map Int [(Set StateDependency, InternalState)])
forall s a. STRef s a -> ST s a
readSTRef (STRef s (Map Int [(Set StateDependency, InternalState)])
-> ST s (Map Int [(Set StateDependency, InternalState)]))
-> STRef s (Map Int [(Set StateDependency, InternalState)])
-> ST s (Map Int [(Set StateDependency, InternalState)])
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s (Map Int [(Set StateDependency, InternalState)])
forall s.
Ctx s -> STRef s (Map Int [(Set StateDependency, InternalState)])
cCache Ctx s
ctx
Bool
enable <- STRef s Bool -> ST s Bool
forall s a. STRef s a -> ST s a
readSTRef (STRef s Bool -> ST s Bool) -> STRef s Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s Bool
forall s. Ctx s -> STRef s Bool
cEnableCache Ctx s
ctx
(String, Int, String, Int,
Maybe [(Set StateDependency, InternalState)])
-> ST s ()
forall (m :: * -> *) p. Monad m => p -> m ()
logVerbose (String
"Cache for", Int
node, String
"length", [(Set StateDependency, InternalState)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Set StateDependency, InternalState)] -> Int)
-> [(Set StateDependency, InternalState)] -> Int
forall a b. (a -> b) -> a -> b
$ [(Set StateDependency, InternalState)]
-> Int
-> Map Int [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Int
node Map Int [(Set StateDependency, InternalState)]
cache, Int
-> Map Int [(Set StateDependency, InternalState)]
-> Maybe [(Set StateDependency, InternalState)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
node Map Int [(Set StateDependency, InternalState)]
cache)
if Bool
enable
then [(Set StateDependency, InternalState)]
-> ST s (Maybe InternalState)
forall a. [(Set StateDependency, a)] -> ST s (Maybe a)
f ([(Set StateDependency, InternalState)]
-> ST s (Maybe InternalState))
-> [(Set StateDependency, InternalState)]
-> ST s (Maybe InternalState)
forall a b. (a -> b) -> a -> b
$ [(Set StateDependency, InternalState)]
-> Int
-> Map Int [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Int
node Map Int [(Set StateDependency, InternalState)]
cache
else Maybe InternalState -> ST s (Maybe InternalState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InternalState
forall a. Maybe a
Nothing
where
f :: [(Set StateDependency, a)] -> ST s (Maybe a)
f [] = Maybe a -> ST s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
f ((Set StateDependency
deps, a
value):[(Set StateDependency, a)]
rest) = do
Bool
match <- Ctx s -> Int -> Set StateDependency -> ST s Bool
forall s. Ctx s -> Int -> Set StateDependency -> ST s Bool
fulfillsDependencies Ctx s
ctx Int
node Set StateDependency
deps
if Bool
match
then Maybe a -> ST s (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ST s (Maybe a)) -> Maybe a -> ST s (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
value
else [(Set StateDependency, a)] -> ST s (Maybe a)
f [(Set StateDependency, a)]
rest
transferEffect :: Ctx s -> CFEffect -> ST s ()
transferEffect Ctx s
ctx CFEffect
effect =
case CFEffect
effect of
CFReadVariable String
name ->
case String
name of
String
"?" -> ST s (Set Id) -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s (Set Id) -> ST s ()) -> ST s (Set Id) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ctx s -> ST s (Set Id)
forall s. Ctx s -> ST s (Set Id)
readExitCodes Ctx s
ctx
String
_ -> ST s VariableState -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ST s VariableState -> ST s ()) -> ST s VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readVariable Ctx s
ctx String
name
CFWriteVariable String
name CFValue
value -> do
VariableValue
val <- Ctx s -> CFValue -> ST s VariableValue
forall s. Ctx s -> CFValue -> ST s VariableValue
cfValueToVariableValue Ctx s
ctx CFValue
value
Ctx s -> String -> VariableValue -> ST s ()
forall s. Ctx s -> String -> VariableValue -> ST s ()
updateVariableValue Ctx s
ctx String
name VariableValue
val
CFWriteGlobal String
name CFValue
value -> do
VariableValue
val <- Ctx s -> CFValue -> ST s VariableValue
forall s. Ctx s -> CFValue -> ST s VariableValue
cfValueToVariableValue Ctx s
ctx CFValue
value
Ctx s -> String -> VariableValue -> ST s ()
forall s. Ctx s -> String -> VariableValue -> ST s ()
updateGlobalValue Ctx s
ctx String
name VariableValue
val
CFWriteLocal String
name CFValue
value -> do
VariableValue
val <- Ctx s -> CFValue -> ST s VariableValue
forall s. Ctx s -> CFValue -> ST s VariableValue
cfValueToVariableValue Ctx s
ctx CFValue
value
Ctx s -> String -> VariableValue -> ST s ()
forall s. Ctx s -> String -> VariableValue -> ST s ()
updateLocalValue Ctx s
ctx String
name VariableValue
val
CFWritePrefix String
name CFValue
value -> do
VariableValue
val <- Ctx s -> CFValue -> ST s VariableValue
forall s. Ctx s -> CFValue -> ST s VariableValue
cfValueToVariableValue Ctx s
ctx CFValue
value
Ctx s -> String -> VariableValue -> ST s ()
forall s. Ctx s -> String -> VariableValue -> ST s ()
updatePrefixValue Ctx s
ctx String
name VariableValue
val
CFSetProps Scope
scope String
name Set CFVariableProp
props ->
case Scope
scope of
Scope
DefaultScope -> do
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readVariable Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeVariable Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
addProperties Set CFVariableProp
props VariableState
state
Scope
GlobalScope -> do
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readGlobal Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeGlobal Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
addProperties Set CFVariableProp
props VariableState
state
Scope
LocalScope -> do
InternalState
out <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx)
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readLocal Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
addProperties Set CFVariableProp
props VariableState
state
Scope
PrefixScope -> do
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readLocal Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
addProperties Set CFVariableProp
props VariableState
state
CFUnsetProps Scope
scope String
name Set CFVariableProp
props ->
case Scope
scope of
Scope
DefaultScope -> do
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readVariable Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeVariable Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
removeProperties Set CFVariableProp
props VariableState
state
Scope
GlobalScope -> do
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readGlobal Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeGlobal Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
removeProperties Set CFVariableProp
props VariableState
state
Scope
LocalScope -> do
InternalState
out <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx)
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readLocal Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
removeProperties Set CFVariableProp
props VariableState
state
Scope
PrefixScope -> do
VariableState
state <- Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readLocal Ctx s
ctx String
name
Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writeLocal Ctx s
ctx String
name (VariableState -> ST s ()) -> VariableState -> ST s ()
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> VariableState -> VariableState
removeProperties Set CFVariableProp
props VariableState
state
CFUndefineVariable String
name -> Ctx s -> String -> ST s ()
forall s. Ctx s -> String -> ST s ()
undefineVariable Ctx s
ctx String
name
CFUndefineFunction String
name -> Ctx s -> String -> ST s ()
forall s. Ctx s -> String -> ST s ()
undefineFunction Ctx s
ctx String
name
CFUndefine String
name -> do
Ctx s -> String -> ST s ()
forall s. Ctx s -> String -> ST s ()
undefineVariable Ctx s
ctx String
name
Ctx s -> String -> ST s ()
forall s. Ctx s -> String -> ST s ()
undefineFunction Ctx s
ctx String
name
CFDefineFunction String
name Id
id Int
entry Int
exit ->
Ctx s -> String -> FunctionDefinition -> ST s ()
forall s. Ctx s -> String -> FunctionDefinition -> ST s ()
writeFunction Ctx s
ctx String
name (FunctionDefinition -> ST s ()) -> FunctionDefinition -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> FunctionDefinition
FunctionDefinition String
name Int
entry Int
exit
CFUndefineNameref String
name -> Ctx s -> String -> ST s ()
forall s. Ctx s -> String -> ST s ()
undefineVariable Ctx s
ctx String
name
CFHintArray String
name -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CFHintDefined String
name -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cfValueToVariableValue :: Ctx s -> CFValue -> ST s VariableValue
cfValueToVariableValue Ctx s
ctx CFValue
val =
case CFValue
val of
CFValue
CFValueArray -> VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownVariableValue
CFValueComputed Id
_ [CFStringPart]
parts -> (VariableValue -> CFStringPart -> ST s VariableValue)
-> VariableValue -> [CFStringPart] -> ST s VariableValue
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM VariableValue -> CFStringPart -> ST s VariableValue
f VariableValue
emptyVariableValue [CFStringPart]
parts
CFValue
CFValueInteger -> VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownIntegerValue
CFValue
CFValueString -> VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownVariableValue
CFValue
CFValueUninitialized -> VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
emptyVariableValue
where
f :: VariableValue -> CFStringPart -> ST s VariableValue
f VariableValue
val CFStringPart
part = do
VariableValue
next <- Ctx s -> CFStringPart -> ST s VariableValue
forall s. Ctx s -> CFStringPart -> ST s VariableValue
computeValue Ctx s
ctx CFStringPart
part
VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableValue -> ST s VariableValue)
-> VariableValue -> ST s VariableValue
forall a b. (a -> b) -> a -> b
$ VariableValue
val VariableValue -> VariableValue -> VariableValue
`appendVariableValue` VariableValue
next
computeValue :: Ctx s -> CFStringPart -> ST s VariableValue
computeValue Ctx s
ctx CFStringPart
part =
case CFStringPart
part of
CFStringLiteral String
str -> VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableValue -> ST s VariableValue)
-> VariableValue -> ST s VariableValue
forall a b. (a -> b) -> a -> b
$ String -> VariableValue
literalToVariableValue String
str
CFStringPart
CFStringInteger -> VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownIntegerValue
CFStringPart
CFStringUnknown -> VariableValue -> ST s VariableValue
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownVariableValue
CFStringVariable String
name -> VariableState -> VariableValue
variableStateToValue (VariableState -> VariableValue)
-> ST s VariableState -> ST s VariableValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx s -> String -> ST s VariableState
forall s. Ctx s -> String -> ST s VariableState
readVariable Ctx s
ctx String
name
where
variableStateToValue :: VariableState -> VariableValue
variableStateToValue VariableState
state =
case () of
()
_ | (Set CFVariableProp -> Bool) -> VariableProperties -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (CFVariableProp
CFVPInteger CFVariableProp -> Set CFVariableProp -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member`) (VariableProperties -> Bool) -> VariableProperties -> Bool
forall a b. (a -> b) -> a -> b
$ VariableState -> VariableProperties
variableProperties VariableState
state -> VariableValue
unknownIntegerValue
()
_ -> VariableState -> VariableValue
variableValue VariableState
state
appendVariableValue :: VariableValue -> VariableValue -> VariableValue
appendVariableValue :: VariableValue -> VariableValue -> VariableValue
appendVariableValue VariableValue
a VariableValue
b =
VariableValue
unknownVariableValue {
literalValue :: Maybe String
literalValue = (String -> ShowS) -> Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (VariableValue -> Maybe String
literalValue VariableValue
a) (VariableValue -> Maybe String
literalValue VariableValue
b),
spaceStatus :: SpaceStatus
spaceStatus = SpaceStatus -> SpaceStatus -> SpaceStatus
appendSpaceStatus (VariableValue -> SpaceStatus
spaceStatus VariableValue
a) (VariableValue -> SpaceStatus
spaceStatus VariableValue
b),
numericalStatus :: NumericalStatus
numericalStatus = NumericalStatus -> NumericalStatus -> NumericalStatus
appendNumericalStatus (VariableValue -> NumericalStatus
numericalStatus VariableValue
a) (VariableValue -> NumericalStatus
numericalStatus VariableValue
b)
}
appendSpaceStatus :: SpaceStatus -> SpaceStatus -> SpaceStatus
appendSpaceStatus SpaceStatus
a SpaceStatus
b =
case (SpaceStatus
a,SpaceStatus
b) of
(SpaceStatus
SpaceStatusEmpty, SpaceStatus
_) -> SpaceStatus
b
(SpaceStatus
_, SpaceStatus
SpaceStatusEmpty) -> SpaceStatus
a
(SpaceStatus
SpaceStatusClean, SpaceStatus
SpaceStatusClean) -> SpaceStatus
a
(SpaceStatus, SpaceStatus)
_ ->SpaceStatus
SpaceStatusDirty
appendNumericalStatus :: NumericalStatus -> NumericalStatus -> NumericalStatus
appendNumericalStatus NumericalStatus
a NumericalStatus
b =
case (NumericalStatus
a,NumericalStatus
b) of
(NumericalStatus
NumericalStatusEmpty, NumericalStatus
x) -> NumericalStatus
x
(NumericalStatus
x, NumericalStatus
NumericalStatusEmpty) -> NumericalStatus
x
(NumericalStatus
NumericalStatusDefinitely, NumericalStatus
NumericalStatusDefinitely) -> NumericalStatus
NumericalStatusDefinitely
(NumericalStatus
NumericalStatusUnknown, NumericalStatus
_) -> NumericalStatus
NumericalStatusUnknown
(NumericalStatus
_, NumericalStatus
NumericalStatusUnknown) -> NumericalStatus
NumericalStatusUnknown
(NumericalStatus, NumericalStatus)
_ -> NumericalStatus
NumericalStatusMaybe
unknownIntegerValue :: VariableValue
unknownIntegerValue = VariableValue
unknownVariableValue {
literalValue :: Maybe String
literalValue = Maybe String
forall a. Maybe a
Nothing,
spaceStatus :: SpaceStatus
spaceStatus = SpaceStatus
SpaceStatusClean,
numericalStatus :: NumericalStatus
numericalStatus = NumericalStatus
NumericalStatusDefinitely
}
literalToVariableValue :: String -> VariableValue
literalToVariableValue String
str = VariableValue
unknownVariableValue {
literalValue :: Maybe String
literalValue = String -> Maybe String
forall a. a -> Maybe a
Just String
str,
spaceStatus :: SpaceStatus
spaceStatus = String -> SpaceStatus
literalToSpaceStatus String
str,
numericalStatus :: NumericalStatus
numericalStatus = String -> NumericalStatus
literalToNumericalStatus String
str
}
withoutChanges :: Ctx s -> ST s b -> ST s b
withoutChanges Ctx s
ctx ST s b
f = do
let inp :: STRef s InternalState
inp = Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cInput Ctx s
ctx
let out :: STRef s InternalState
out = Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx
InternalState
prevInput <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
inp
InternalState
prevOutput <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
out
b
res <- ST s b
f
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
inp InternalState
prevInput
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s InternalState
out InternalState
prevOutput
b -> ST s b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
literalToSpaceStatus :: String -> SpaceStatus
literalToSpaceStatus String
str =
case String
str of
String
"" -> SpaceStatus
SpaceStatusEmpty
String
_ | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
" \t\n*?[") String
str -> SpaceStatus
SpaceStatusClean
String
_ -> SpaceStatus
SpaceStatusDirty
literalToNumericalStatus :: String -> NumericalStatus
literalToNumericalStatus String
str =
case String
str of
String
"" -> NumericalStatus
NumericalStatusEmpty
Char
'-':String
rest -> if String -> Bool
isNumeric String
rest then NumericalStatus
NumericalStatusDefinitely else NumericalStatus
NumericalStatusUnknown
String
rest -> if String -> Bool
isNumeric String
rest then NumericalStatus
NumericalStatusDefinitely else NumericalStatus
NumericalStatusUnknown
where
isNumeric :: String -> Bool
isNumeric = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit
type StateMap = M.Map Node (InternalState, InternalState)
dataflow :: forall s. Ctx s -> Node -> ST s StateMap
dataflow :: Ctx s -> Int -> ST s (Map Int (InternalState, InternalState))
dataflow Ctx s
ctx Int
entry = do
STRef s (Set Int)
pending <- Set Int -> ST s (STRef s (Set Int))
forall a s. a -> ST s (STRef s a)
newSTRef (Set Int -> ST s (STRef s (Set Int)))
-> Set Int -> ST s (STRef s (Set Int))
forall a b. (a -> b) -> a -> b
$ Int -> Set Int
forall a. a -> Set a
S.singleton Int
entry
STRef s (Map Int (InternalState, InternalState))
states <- Map Int (InternalState, InternalState)
-> ST s (STRef s (Map Int (InternalState, InternalState)))
forall a s. a -> ST s (STRef s a)
newSTRef (Map Int (InternalState, InternalState)
-> ST s (STRef s (Map Int (InternalState, InternalState))))
-> Map Int (InternalState, InternalState)
-> ST s (STRef s (Map Int (InternalState, InternalState)))
forall a b. (a -> b) -> a -> b
$ Map Int (InternalState, InternalState)
forall k a. Map k a
M.empty
Ctx s -> ST s () -> ST s ()
forall s b. Ctx s -> ST s b -> ST s b
withoutChanges Ctx s
ctx (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
Integer
-> STRef s (Set Int)
-> STRef s (Map Int (InternalState, InternalState))
-> ST s ()
f Integer
iterationCount STRef s (Set Int)
pending STRef s (Map Int (InternalState, InternalState))
states
STRef s (Map Int (InternalState, InternalState))
-> ST s (Map Int (InternalState, InternalState))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Map Int (InternalState, InternalState))
states
where
graph :: CFGraph
graph = Ctx s -> CFGraph
forall s. Ctx s -> CFGraph
cGraph Ctx s
ctx
f :: Integer
-> STRef s (Set Int)
-> STRef s (Map Int (InternalState, InternalState))
-> ST s ()
f Integer
0 STRef s (Set Int)
_ STRef s (Map Int (InternalState, InternalState))
_ = String -> ST s ()
forall a. HasCallStack => String -> a
error (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"DFA did not reach fix point"
f Integer
n STRef s (Set Int)
pending STRef s (Map Int (InternalState, InternalState))
states = do
Set Int
ps <- STRef s (Set Int) -> ST s (Set Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Set Int)
pending
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
fallbackThreshold) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
String -> ST s ()
forall (m :: * -> *) p. Monad m => p -> m ()
logInfo String
"DFA is not stabilizing! Disabling cache."
STRef s Bool -> Bool -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s Bool
forall s. Ctx s -> STRef s Bool
cEnableCache Ctx s
ctx) Bool
False
if Set Int -> Bool
forall a. Set a -> Bool
S.null Set Int
ps
then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let (Int
next, Set Int
rest) = Set Int -> (Int, Set Int)
forall a. Set a -> (a, Set a)
S.deleteFindMin Set Int
ps
[Int]
nexts <- STRef s (Map Int (InternalState, InternalState))
-> Int -> ST s [Int]
process STRef s (Map Int (InternalState, InternalState))
states Int
next
STRef s (Set Int) -> Set Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Set Int)
pending (Set Int -> ST s ()) -> Set Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ (Set Int -> Int -> Set Int) -> Set Int -> [Int] -> Set Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Int -> Set Int -> Set Int) -> Set Int -> Int -> Set Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Set Int -> Set Int
forall a. Ord a => a -> Set a -> Set a
S.insert) Set Int
rest [Int]
nexts
Integer
-> STRef s (Set Int)
-> STRef s (Map Int (InternalState, InternalState))
-> ST s ()
f (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) STRef s (Set Int)
pending STRef s (Map Int (InternalState, InternalState))
states
process :: STRef s (Map Int (InternalState, InternalState))
-> Int -> ST s [Int]
process STRef s (Map Int (InternalState, InternalState))
states Int
node = do
Map Int (InternalState, InternalState)
stateMap <- STRef s (Map Int (InternalState, InternalState))
-> ST s (Map Int (InternalState, InternalState))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Map Int (InternalState, InternalState))
states
let inputs :: [InternalState]
inputs = (InternalState -> Bool) -> [InternalState] -> [InternalState]
forall a. (a -> Bool) -> [a] -> [a]
filter (\InternalState
c -> InternalState -> Maybe Bool
sIsReachable InternalState
c Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) ([InternalState] -> [InternalState])
-> [InternalState] -> [InternalState]
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe InternalState) -> [Int] -> [InternalState]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Int
c -> ((InternalState, InternalState) -> InternalState)
-> Maybe (InternalState, InternalState) -> Maybe InternalState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InternalState, InternalState) -> InternalState
forall a b. (a, b) -> b
snd (Maybe (InternalState, InternalState) -> Maybe InternalState)
-> Maybe (InternalState, InternalState) -> Maybe InternalState
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
c Map Int (InternalState, InternalState)
stateMap) [Int]
incoming
InternalState
input <-
case [Int]
incoming of
[] -> InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
newInternalState
[Int]
_ ->
case [InternalState]
inputs of
[] -> InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
unreachableState
(InternalState
x:[InternalState]
rest) -> (InternalState -> InternalState -> ST s InternalState)
-> InternalState -> [InternalState] -> ST s InternalState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Ctx s -> InternalState -> InternalState -> ST s InternalState
forall s.
Ctx s -> InternalState -> InternalState -> ST s InternalState
mergeState Ctx s
ctx) InternalState
x [InternalState]
rest
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cInput Ctx s
ctx) (InternalState -> ST s ()) -> InternalState -> ST s ()
forall a b. (a -> b) -> a -> b
$ InternalState
input
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) (InternalState -> ST s ()) -> InternalState -> ST s ()
forall a b. (a -> b) -> a -> b
$ InternalState
input
STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s Int
forall s. Ctx s -> STRef s Int
cNode Ctx s
ctx) (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
node
Ctx s -> CFNode -> ST s ()
forall s. Ctx s -> CFNode -> ST s ()
transfer Ctx s
ctx CFNode
label
InternalState
newOutput <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef (STRef s InternalState -> ST s InternalState)
-> STRef s InternalState -> ST s InternalState
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx
InternalState
result <-
if [Int] -> Bool
forall a. [a] -> Bool
is2plus [Int]
outgoing
then
Ctx s -> InternalState -> ST s InternalState
forall s. Ctx s -> InternalState -> ST s InternalState
versionState Ctx s
ctx InternalState
newOutput
else InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
newOutput
STRef s (Map Int (InternalState, InternalState))
-> Map Int (InternalState, InternalState) -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Map Int (InternalState, InternalState))
states (Map Int (InternalState, InternalState) -> ST s ())
-> Map Int (InternalState, InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
-> (InternalState, InternalState)
-> Map Int (InternalState, InternalState)
-> Map Int (InternalState, InternalState)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
node (InternalState
input, InternalState
result) Map Int (InternalState, InternalState)
stateMap
case Int
-> Map Int (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
node Map Int (InternalState, InternalState)
stateMap of
Maybe (InternalState, InternalState)
Nothing -> [Int] -> ST s [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
outgoing
Just (InternalState
oldInput, InternalState
oldOutput) ->
if InternalState
oldOutput InternalState -> InternalState -> Bool
forall a. Eq a => a -> a -> Bool
== InternalState
result
then [Int] -> ST s [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Int] -> ST s [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
outgoing
where
(Adj CFEdge
incomingL, Int
_, CFNode
label, Adj CFEdge
outgoingL) = CFGraph -> Int -> (Adj CFEdge, Int, CFNode, Adj CFEdge)
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context CFGraph
graph (Int -> (Adj CFEdge, Int, CFNode, Adj CFEdge))
-> Int -> (Adj CFEdge, Int, CFNode, Adj CFEdge)
forall a b. (a -> b) -> a -> b
$ Int
node
incoming :: [Int]
incoming = ((CFEdge, Int) -> Int) -> Adj CFEdge -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CFEdge, Int) -> Int
forall a b. (a, b) -> b
snd (Adj CFEdge -> [Int]) -> Adj CFEdge -> [Int]
forall a b. (a -> b) -> a -> b
$ ((CFEdge, Int) -> Bool) -> Adj CFEdge -> Adj CFEdge
forall a. (a -> Bool) -> [a] -> [a]
filter (CFEdge, Int) -> Bool
forall b. (CFEdge, b) -> Bool
isRegular (Adj CFEdge -> Adj CFEdge) -> Adj CFEdge -> Adj CFEdge
forall a b. (a -> b) -> a -> b
$ Adj CFEdge
incomingL
outgoing :: [Int]
outgoing = ((CFEdge, Int) -> Int) -> Adj CFEdge -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CFEdge, Int) -> Int
forall a b. (a, b) -> b
snd Adj CFEdge
outgoingL
isRegular :: (CFEdge, b) -> Bool
isRegular = ((CFEdge -> CFEdge -> Bool
forall a. Eq a => a -> a -> Bool
== CFEdge
CFEFlow) (CFEdge -> Bool) -> ((CFEdge, b) -> CFEdge) -> (CFEdge, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CFEdge, b) -> CFEdge
forall a b. (a, b) -> a
fst)
runRoot :: Ctx s -> InternalState -> Int -> Int -> ST s InternalState
runRoot Ctx s
ctx InternalState
env Int
entry Int
exit = do
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cInput Ctx s
ctx) (InternalState -> ST s ()) -> InternalState -> ST s ()
forall a b. (a -> b) -> a -> b
$ InternalState
env
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) (InternalState -> ST s ()) -> InternalState -> ST s ()
forall a b. (a -> b) -> a -> b
$ InternalState
env
STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s Int
forall s. Ctx s -> STRef s Int
cNode Ctx s
ctx) (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
entry
(Map Int (InternalState, InternalState)
states, StackEntry s
frame) <- Ctx s
-> Int
-> Bool
-> (Ctx s -> ST s (Map Int (InternalState, InternalState)))
-> ST s (Map Int (InternalState, InternalState), StackEntry s)
forall s a.
Ctx s -> Int -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Int
entry Bool
False ((Ctx s -> ST s (Map Int (InternalState, InternalState)))
-> ST s (Map Int (InternalState, InternalState), StackEntry s))
-> (Ctx s -> ST s (Map Int (InternalState, InternalState)))
-> ST s (Map Int (InternalState, InternalState), StackEntry s)
forall a b. (a -> b) -> a -> b
$ \Ctx s
c -> Ctx s -> Int -> ST s (Map Int (InternalState, InternalState))
forall s.
Ctx s -> Int -> ST s (Map Int (InternalState, InternalState))
dataflow Ctx s
c Int
entry
Set StateDependency
deps <- STRef s (Set StateDependency) -> ST s (Set StateDependency)
forall s a. STRef s a -> ST s a
readSTRef (STRef s (Set StateDependency) -> ST s (Set StateDependency))
-> STRef s (Set StateDependency) -> ST s (Set StateDependency)
forall a b. (a -> b) -> a -> b
$ StackEntry s -> STRef s (Set StateDependency)
forall s. StackEntry s -> STRef s (Set StateDependency)
dependencies StackEntry s
frame
Ctx s
-> Int
-> Map Int (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
forall s.
Ctx s
-> Int
-> Map Int (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Int
entry Map Int (InternalState, InternalState)
states Set StateDependency
deps
InternalState -> ST s InternalState
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalState -> ST s InternalState)
-> InternalState -> ST s InternalState
forall a b. (a -> b) -> a -> b
$ (InternalState, InternalState) -> InternalState
forall a b. (a, b) -> b
snd ((InternalState, InternalState) -> InternalState)
-> (InternalState, InternalState) -> InternalState
forall a b. (a -> b) -> a -> b
$ (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
-> (InternalState, InternalState)
forall a. a -> Maybe a -> a
fromMaybe (String -> (InternalState, InternalState)
forall a. HasCallStack => String -> a
error (String -> (InternalState, InternalState))
-> String -> (InternalState, InternalState)
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Missing exit state") (Maybe (InternalState, InternalState)
-> (InternalState, InternalState))
-> Maybe (InternalState, InternalState)
-> (InternalState, InternalState)
forall a b. (a -> b) -> a -> b
$ Int
-> Map Int (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
exit Map Int (InternalState, InternalState)
states
analyzeControlFlow :: CFGParameters -> Token -> CFGAnalysis
analyzeControlFlow :: CFGParameters -> Token -> CFGAnalysis
analyzeControlFlow CFGParameters
params Token
t =
let
cfg :: CFGResult
cfg = CFGParameters -> Token -> CFGResult
buildGraph CFGParameters
params Token
t
(Int
entry, Int
exit) = (Int, Int) -> Id -> Map Id (Int, Int) -> (Int, Int)
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (String -> (Int, Int)
forall a. HasCallStack => String -> a
error (String -> (Int, Int)) -> String -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Missing root") (Token -> Id
getId Token
t) (CFGResult -> Map Id (Int, Int)
cfIdToRange CFGResult
cfg)
in
(forall s. ST s CFGAnalysis) -> CFGAnalysis
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s CFGAnalysis) -> CFGAnalysis)
-> (forall s. ST s CFGAnalysis) -> CFGAnalysis
forall a b. (a -> b) -> a -> b
$ CFGResult -> Int -> Int -> ST s CFGAnalysis
forall s. CFGResult -> Int -> Int -> ST s CFGAnalysis
f CFGResult
cfg Int
entry Int
exit
where
f :: CFGResult -> Int -> Int -> ST s CFGAnalysis
f CFGResult
cfg Int
entry Int
exit = do
let env :: InternalState
env = InternalState
createEnvironmentState
Ctx s
ctx <- CFGraph -> ST s (Ctx s)
forall s. CFGraph -> ST s (Ctx s)
newCtx (CFGraph -> ST s (Ctx s)) -> CFGraph -> ST s (Ctx s)
forall a b. (a -> b) -> a -> b
$ CFGResult -> CFGraph
cfGraph CFGResult
cfg
InternalState
exitState <- Ctx s -> InternalState -> Int -> Int -> ST s InternalState
forall s.
Ctx s -> InternalState -> Int -> Int -> ST s InternalState
runRoot Ctx s
ctx InternalState
env Int
entry Int
exit
Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
invocations <- STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
forall s a. STRef s a -> ST s a
readSTRef (STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState))))
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
forall a b. (a -> b) -> a -> b
$ Ctx s
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
forall s.
Ctx s
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
cInvocations Ctx s
ctx
let invokedNodes :: Map Int ()
invokedNodes = [(Int, ())] -> Map Int ()
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList ([(Int, ())] -> Map Int ()) -> [(Int, ())] -> Map Int ()
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, ())) -> [Int] -> [(Int, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
c -> (Int
c, ())) ([Int] -> [(Int, ())]) -> [Int] -> [(Int, ())]
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
S.toList (Set Int -> [Int]) -> Set Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Map Int [(InternalState, InternalState)] -> Set Int
forall k a. Map k a -> Set k
M.keysSet (Map Int [(InternalState, InternalState)] -> Set Int)
-> Map Int [(InternalState, InternalState)] -> Set Int
forall a b. (a -> b) -> a -> b
$ Map [Int] (Map Int (InternalState, InternalState))
-> Map Int [(InternalState, InternalState)]
forall k v. Map k (Map Int v) -> Map Int [v]
groupByNode (Map [Int] (Map Int (InternalState, InternalState))
-> Map Int [(InternalState, InternalState)])
-> Map [Int] (Map Int (InternalState, InternalState))
-> Map Int [(InternalState, InternalState)]
forall a b. (a -> b) -> a -> b
$ ((Set StateDependency, Map Int (InternalState, InternalState))
-> Map Int (InternalState, InternalState))
-> Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
-> Map [Int] (Map Int (InternalState, InternalState))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Set StateDependency, Map Int (InternalState, InternalState))
-> Map Int (InternalState, InternalState)
forall a b. (a, b) -> b
snd Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
invocations
let declaredFunctions :: Map Int FunctionDefinition
declaredFunctions = InternalState -> Map Int FunctionDefinition
getFunctionTargets InternalState
exitState
let uninvoked :: Map Int FunctionDefinition
uninvoked = Map Int FunctionDefinition
-> Map Int () -> Map Int FunctionDefinition
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference Map Int FunctionDefinition
declaredFunctions Map Int ()
invokedNodes
let stragglerInput :: InternalState
stragglerInput =
(InternalState
env InternalState -> InternalState -> InternalState
`patchState` InternalState
exitState) {
sExitCodes :: Maybe (Set Id)
sExitCodes = Maybe (Set Id)
forall a. Maybe a
Nothing
}
Ctx s -> InternalState -> Map Int FunctionDefinition -> ST s ()
forall s k.
Ctx s -> InternalState -> Map k FunctionDefinition -> ST s ()
analyzeStragglers Ctx s
ctx InternalState
stragglerInput Map Int FunctionDefinition
uninvoked
Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
invocations <- STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
forall s a. STRef s a -> ST s a
readSTRef (STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState))))
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
-> ST
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
forall a b. (a -> b) -> a -> b
$ Ctx s
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
forall s.
Ctx s
-> STRef
s
(Map
[Int]
(Set StateDependency, Map Int (InternalState, InternalState)))
cInvocations Ctx s
ctx
Map Int (InternalState, InternalState)
invokedStates <- Ctx s
-> Map Int [(InternalState, InternalState)]
-> ST s (Map Int (InternalState, InternalState))
forall s k.
Ctx s
-> Map k [(InternalState, InternalState)]
-> ST s (Map k (InternalState, InternalState))
flattenByNode Ctx s
ctx (Map Int [(InternalState, InternalState)]
-> ST s (Map Int (InternalState, InternalState)))
-> Map Int [(InternalState, InternalState)]
-> ST s (Map Int (InternalState, InternalState))
forall a b. (a -> b) -> a -> b
$ Map [Int] (Map Int (InternalState, InternalState))
-> Map Int [(InternalState, InternalState)]
forall k v. Map k (Map Int v) -> Map Int [v]
groupByNode (Map [Int] (Map Int (InternalState, InternalState))
-> Map Int [(InternalState, InternalState)])
-> Map [Int] (Map Int (InternalState, InternalState))
-> Map Int [(InternalState, InternalState)]
forall a b. (a -> b) -> a -> b
$ ((Set StateDependency, Map Int (InternalState, InternalState))
-> Map Int (InternalState, InternalState))
-> Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
-> Map [Int] (Map Int (InternalState, InternalState))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Set StateDependency, Map Int (InternalState, InternalState))
-> Map Int (InternalState, InternalState)
addDeps Map
[Int] (Set StateDependency, Map Int (InternalState, InternalState))
invocations
let baseStates :: Map Int (InternalState, InternalState)
baseStates = [(Int, (InternalState, InternalState))]
-> Map Int (InternalState, InternalState)
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList ([(Int, (InternalState, InternalState))]
-> Map Int (InternalState, InternalState))
-> [(Int, (InternalState, InternalState))]
-> Map Int (InternalState, InternalState)
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, (InternalState, InternalState)))
-> [Int] -> [(Int, (InternalState, InternalState))]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
c -> (Int
c, (InternalState
unreachableState, InternalState
unreachableState))) ([Int] -> [(Int, (InternalState, InternalState))])
-> [Int] -> [(Int, (InternalState, InternalState))]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> [Int]) -> (Int, Int) -> [Int]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo ((Int, Int) -> [Int]) -> (Int, Int) -> [Int]
forall a b. (a -> b) -> a -> b
$ CFGraph -> (Int, Int)
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Int, Int)
nodeRange (CFGraph -> (Int, Int)) -> CFGraph -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ CFGResult -> CFGraph
cfGraph CFGResult
cfg
let allStates :: Map Int (InternalState, InternalState)
allStates = ((InternalState, InternalState)
-> (InternalState, InternalState)
-> (InternalState, InternalState))
-> Map Int (InternalState, InternalState)
-> Map Int (InternalState, InternalState)
-> Map Int (InternalState, InternalState)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (((InternalState, InternalState)
-> (InternalState, InternalState)
-> (InternalState, InternalState))
-> (InternalState, InternalState)
-> (InternalState, InternalState)
-> (InternalState, InternalState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (InternalState, InternalState)
-> (InternalState, InternalState) -> (InternalState, InternalState)
forall a b. a -> b -> a
const) Map Int (InternalState, InternalState)
baseStates Map Int (InternalState, InternalState)
invokedStates
let nodeToData :: Map Int (ProgramState, ProgramState)
nodeToData = ((InternalState, InternalState) -> (ProgramState, ProgramState))
-> Map Int (InternalState, InternalState)
-> Map Int (ProgramState, ProgramState)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\(InternalState
a,InternalState
b) -> (InternalState -> ProgramState
internalToExternal InternalState
a, InternalState -> ProgramState
internalToExternal InternalState
b)) Map Int (InternalState, InternalState)
allStates
CFGAnalysis -> ST s CFGAnalysis
forall (m :: * -> *) a. Monad m => a -> m a
return (CFGAnalysis -> ST s CFGAnalysis)
-> CFGAnalysis -> ST s CFGAnalysis
forall a b. (a -> b) -> a -> b
$ Map Int (ProgramState, ProgramState)
nodeToData Map Int (ProgramState, ProgramState) -> CFGAnalysis -> CFGAnalysis
forall a b. NFData a => a -> b -> b
`deepseq` CFGAnalysis :: CFGraph
-> Map Id (Int, Int)
-> Map Id (Set Int)
-> Array Int [Int]
-> Map Int (ProgramState, ProgramState)
-> CFGAnalysis
CFGAnalysis {
graph :: CFGraph
graph = CFGResult -> CFGraph
cfGraph CFGResult
cfg,
tokenToRange :: Map Id (Int, Int)
tokenToRange = CFGResult -> Map Id (Int, Int)
cfIdToRange CFGResult
cfg,
tokenToNodes :: Map Id (Set Int)
tokenToNodes = CFGResult -> Map Id (Set Int)
cfIdToNodes CFGResult
cfg,
nodeToData :: Map Int (ProgramState, ProgramState)
nodeToData = Map Int (ProgramState, ProgramState)
nodeToData,
postDominators :: Array Int [Int]
postDominators = CFGResult -> Array Int [Int]
cfPostDominators CFGResult
cfg
}
addDeps :: (S.Set StateDependency, M.Map Node (InternalState, InternalState)) -> M.Map Node (InternalState, InternalState)
addDeps :: (Set StateDependency, Map Int (InternalState, InternalState))
-> Map Int (InternalState, InternalState)
addDeps (Set StateDependency
deps, Map Int (InternalState, InternalState)
m) = let base :: InternalState
base = Set StateDependency -> InternalState
depsToState Set StateDependency
deps in ((InternalState, InternalState) -> (InternalState, InternalState))
-> Map Int (InternalState, InternalState)
-> Map Int (InternalState, InternalState)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\(InternalState
a,InternalState
b) -> (InternalState
base InternalState -> InternalState -> InternalState
`patchState` InternalState
a, InternalState
base InternalState -> InternalState -> InternalState
`patchState` InternalState
b)) Map Int (InternalState, InternalState)
m
groupByNode :: forall k v. M.Map k (M.Map Node v) -> M.Map Node [v]
groupByNode :: Map k (Map Int v) -> Map Int [v]
groupByNode Map k (Map Int v)
pathMap = ([v] -> [v] -> [v]) -> [(Int, [v])] -> Map Int [v]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [v])] -> Map Int [v]) -> [(Int, [v])] -> Map Int [v]
forall a b. (a -> b) -> a -> b
$ ((Int, v) -> (Int, [v])) -> [(Int, v)] -> [(Int, [v])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
k,v
v) -> (Int
k,[v
v])) ([(Int, v)] -> [(Int, [v])]) -> [(Int, v)] -> [(Int, [v])]
forall a b. (a -> b) -> a -> b
$ (Map Int v -> [(Int, v)]) -> [Map Int v] -> [(Int, v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Map Int v -> [(Int, v)]
forall k a. Map k a -> [(k, a)]
M.toList ([Map Int v] -> [(Int, v)]) -> [Map Int v] -> [(Int, v)]
forall a b. (a -> b) -> a -> b
$ Map k (Map Int v) -> [Map Int v]
forall k a. Map k a -> [a]
M.elems Map k (Map Int v)
pathMap
flattenByNode :: Ctx s
-> Map k [(InternalState, InternalState)]
-> ST s (Map k (InternalState, InternalState))
flattenByNode Ctx s
ctx Map k [(InternalState, InternalState)]
m = [(k, (InternalState, InternalState))]
-> Map k (InternalState, InternalState)
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList ([(k, (InternalState, InternalState))]
-> Map k (InternalState, InternalState))
-> ST s [(k, (InternalState, InternalState))]
-> ST s (Map k (InternalState, InternalState))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((k, [(InternalState, InternalState)])
-> ST s (k, (InternalState, InternalState)))
-> [(k, [(InternalState, InternalState)])]
-> ST s [(k, (InternalState, InternalState))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ctx s
-> (k, [(InternalState, InternalState)])
-> ST s (k, (InternalState, InternalState))
forall s a.
Ctx s
-> (a, [(InternalState, InternalState)])
-> ST s (a, (InternalState, InternalState))
mergePair Ctx s
ctx) ([(k, [(InternalState, InternalState)])]
-> ST s [(k, (InternalState, InternalState))])
-> [(k, [(InternalState, InternalState)])]
-> ST s [(k, (InternalState, InternalState))]
forall a b. (a -> b) -> a -> b
$ Map k [(InternalState, InternalState)]
-> [(k, [(InternalState, InternalState)])]
forall k a. Map k a -> [(k, a)]
M.toList Map k [(InternalState, InternalState)]
m)
mergeAllStates :: Ctx s
-> [(InternalState, InternalState)]
-> ST s (InternalState, InternalState)
mergeAllStates Ctx s
ctx [(InternalState, InternalState)]
pairs =
let
([InternalState]
pres, [InternalState]
posts) = [(InternalState, InternalState)]
-> ([InternalState], [InternalState])
forall a b. [(a, b)] -> ([a], [b])
unzip [(InternalState, InternalState)]
pairs
in do
InternalState
pre <- Ctx s -> InternalState -> [InternalState] -> ST s InternalState
forall s.
Ctx s -> InternalState -> [InternalState] -> ST s InternalState
mergeStates Ctx s
ctx (String -> InternalState
forall a. HasCallStack => String -> a
error (String -> InternalState) -> String -> InternalState
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Null node states") [InternalState]
pres
InternalState
post <- Ctx s -> InternalState -> [InternalState] -> ST s InternalState
forall s.
Ctx s -> InternalState -> [InternalState] -> ST s InternalState
mergeStates Ctx s
ctx (String -> InternalState
forall a. HasCallStack => String -> a
error (String -> InternalState) -> String -> InternalState
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Null node states") [InternalState]
posts
(InternalState, InternalState)
-> ST s (InternalState, InternalState)
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalState
pre, InternalState
post)
mergePair :: Ctx s
-> (a, [(InternalState, InternalState)])
-> ST s (a, (InternalState, InternalState))
mergePair Ctx s
ctx (a
node, [(InternalState, InternalState)]
list) = do
(InternalState, InternalState)
merged <- Ctx s
-> [(InternalState, InternalState)]
-> ST s (InternalState, InternalState)
forall s.
Ctx s
-> [(InternalState, InternalState)]
-> ST s (InternalState, InternalState)
mergeAllStates Ctx s
ctx [(InternalState, InternalState)]
list
(a, (InternalState, InternalState))
-> ST s (a, (InternalState, InternalState))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
node, (InternalState, InternalState)
merged)
getFunctionTargets :: InternalState -> M.Map Node FunctionDefinition
getFunctionTargets :: InternalState -> Map Int FunctionDefinition
getFunctionTargets InternalState
state =
let
declaredFuncs :: FunctionValue
declaredFuncs = [FunctionValue] -> FunctionValue
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([FunctionValue] -> FunctionValue)
-> [FunctionValue] -> FunctionValue
forall a b. (a -> b) -> a -> b
$ Map String FunctionValue -> [FunctionValue]
forall k a. Map k a -> [a]
M.elems (Map String FunctionValue -> [FunctionValue])
-> Map String FunctionValue -> [FunctionValue]
forall a b. (a -> b) -> a -> b
$ VersionedMap String FunctionValue -> Map String FunctionValue
forall k v. VersionedMap k v -> Map k v
mapStorage (VersionedMap String FunctionValue -> Map String FunctionValue)
-> VersionedMap String FunctionValue -> Map String FunctionValue
forall a b. (a -> b) -> a -> b
$ InternalState -> VersionedMap String FunctionValue
sFunctionTargets InternalState
state
getFunc :: FunctionDefinition -> Maybe (Int, FunctionDefinition)
getFunc FunctionDefinition
d =
case FunctionDefinition
d of
FunctionDefinition String
_ Int
entry Int
_ -> (Int, FunctionDefinition) -> Maybe (Int, FunctionDefinition)
forall a. a -> Maybe a
Just (Int
entry, FunctionDefinition
d)
FunctionDefinition
_ -> Maybe (Int, FunctionDefinition)
forall a. Maybe a
Nothing
funcs :: [(Int, FunctionDefinition)]
funcs = (FunctionDefinition -> Maybe (Int, FunctionDefinition))
-> [FunctionDefinition] -> [(Int, FunctionDefinition)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FunctionDefinition -> Maybe (Int, FunctionDefinition)
getFunc ([FunctionDefinition] -> [(Int, FunctionDefinition)])
-> [FunctionDefinition] -> [(Int, FunctionDefinition)]
forall a b. (a -> b) -> a -> b
$ FunctionValue -> [FunctionDefinition]
forall a. Set a -> [a]
S.toList FunctionValue
declaredFuncs
in
[(Int, FunctionDefinition)] -> Map Int FunctionDefinition
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int, FunctionDefinition)]
funcs
analyzeStragglers :: Ctx s -> InternalState -> Map k FunctionDefinition -> ST s ()
analyzeStragglers Ctx s
ctx InternalState
state Map k FunctionDefinition
stragglers = do
(FunctionDefinition -> ST s ()) -> [FunctionDefinition] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FunctionDefinition -> ST s ()
f ([FunctionDefinition] -> ST s ())
-> [FunctionDefinition] -> ST s ()
forall a b. (a -> b) -> a -> b
$ Map k FunctionDefinition -> [FunctionDefinition]
forall k a. Map k a -> [a]
M.elems Map k FunctionDefinition
stragglers
where
f :: FunctionDefinition -> ST s ()
f def :: FunctionDefinition
def@(FunctionDefinition String
name Int
entry Int
exit) = do
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cInput Ctx s
ctx) InternalState
state
STRef s InternalState -> InternalState -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s InternalState
forall s. Ctx s -> STRef s InternalState
cOutput Ctx s
ctx) InternalState
state
STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s Int
forall s. Ctx s -> STRef s Int
cNode Ctx s
ctx) Int
entry
Ctx s -> FunctionDefinition -> ST s ()
forall s. Ctx s -> FunctionDefinition -> ST s ()
transferFunctionValue Ctx s
ctx FunctionDefinition
def
return []
runTests :: IO Bool
runTests = [(String, Property)]
[(String, Property)] -> (Property -> IO Result) -> IO Bool
Property -> IO Result
forall prop. Testable prop => prop -> IO Result
runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
quickCheckResult :: forall prop. Testable prop => prop -> IO Result
$quickCheckAll