{-
    Copyright 2022 Vidar Holen

    This file is part of ShellCheck.
    https://www.shellcheck.net

    ShellCheck is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    ShellCheck is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}
{-# LANGUAGE CPP #-}

{-
    Data Flow Analysis on a Control Flow Graph.

    This module implements a pretty standard iterative Data Flow Analysis.
    For an overview of the process, see Wikipedia.

    Since shell scripts rely heavily on global variables, this DFA includes
    tracking the value of globals across calls. Each function invocation is
    treated as a separate DFA problem, and a caching mechanism (hopefully)
    avoids any exponential explosions.

    To do efficient DFA join operations (or merges, as the code calls them),
    some of the data structures have an integer version attached. On update,
    the version is changed. If two states have the same version number,
    a merge is skipped on the grounds that they are identical. It is easy
    to unintentionally forget to update/invalidate the version number,
    and bugs will ensure.

    For performance reasons, the entire code runs in plain ST, with a manual
    context object Ctx being passed around. It relies heavily on mutable
    STRefs. However, this turned out to be literally thousands of times faster
    than my several attempts using RWST, so it can't be helped.
-}

module ShellCheck.CFGAnalysis (
    analyzeControlFlow
    ,CFGParameters (..)
    ,CFGAnalysis (..)
    ,ProgramState (..)
    ,VariableState (..)
    ,VariableValue (..)
    ,VariableProperties
    ,SpaceStatus (..)
    ,NumericalStatus (..)
    ,getIncomingState
    ,getOutgoingState
    ,doesPostDominate
    ,variableMayBeDeclaredInteger
    ,variableMayBeAssignedInteger
    ,ShellCheck.CFGAnalysis.runTests -- STRIP
    ) 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 -- STRIP
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


-- The number of iterations for DFA to stabilize
iterationCount :: Integer
iterationCount = Integer
1000000
-- There have been multiple bugs where bad caching caused oscillations.
-- As a precaution, disable caching if there's this many iterations left.
fallbackThreshold :: Integer
fallbackThreshold = Integer
10000
-- The number of cache entries to keep per node
cacheEntries :: Node
cacheEntries = Node
10

logVerbose :: p -> m ()
logVerbose p
log = do
    -- traceShowM log
    () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logInfo :: p -> m ()
logInfo p
log = do
    -- traceShowM log
    () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- The result of the data flow analysis
data CFGAnalysis = CFGAnalysis {
    CFGAnalysis -> CFGraph
graph :: CFGraph,
    CFGAnalysis -> Map Id (Node, Node)
tokenToRange :: M.Map Id (Node, Node),
    CFGAnalysis -> Map Id (Set Node)
tokenToNodes :: M.Map Id (S.Set Node),
    CFGAnalysis -> Array Node [Node]
postDominators :: Array Node [Node],
    CFGAnalysis -> Map Node (ProgramState, ProgramState)
nodeToData :: M.Map Node (ProgramState, ProgramState)
} deriving (Node -> CFGAnalysis -> ShowS
[CFGAnalysis] -> ShowS
CFGAnalysis -> String
(Node -> CFGAnalysis -> ShowS)
-> (CFGAnalysis -> String)
-> ([CFGAnalysis] -> ShowS)
-> Show CFGAnalysis
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFGAnalysis -> ShowS
showsPrec :: Node -> CFGAnalysis -> ShowS
$cshow :: CFGAnalysis -> String
show :: CFGAnalysis -> String
$cshowList :: [CFGAnalysis] -> ShowS
showList :: [CFGAnalysis] -> ShowS
Show)

-- The program state we expose externally
data ProgramState = ProgramState {
    -- internalState :: InternalState, -- For debugging
    ProgramState -> Map String VariableState
variablesInScope :: M.Map String VariableState,
    ProgramState -> Set Id
exitCodes :: S.Set Id,
    ProgramState -> Bool
stateIsReachable :: Bool
} deriving (Node -> ProgramState -> ShowS
[ProgramState] -> ShowS
ProgramState -> String
(Node -> ProgramState -> ShowS)
-> (ProgramState -> String)
-> ([ProgramState] -> ShowS)
-> Show ProgramState
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> ProgramState -> ShowS
showsPrec :: Node -> ProgramState -> ShowS
$cshow :: ProgramState -> String
show :: ProgramState -> String
$cshowList :: [ProgramState] -> ShowS
showList :: [ProgramState] -> ShowS
Show, ProgramState -> ProgramState -> Bool
(ProgramState -> ProgramState -> Bool)
-> (ProgramState -> ProgramState -> Bool) -> Eq ProgramState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgramState -> ProgramState -> Bool
== :: ProgramState -> ProgramState -> Bool
$c/= :: ProgramState -> ProgramState -> Bool
/= :: 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
$cfrom :: forall x. ProgramState -> Rep ProgramState x
from :: forall x. ProgramState -> Rep ProgramState x
$cto :: forall x. Rep ProgramState x -> ProgramState
to :: forall x. Rep ProgramState x -> ProgramState
Generic, ProgramState -> ()
(ProgramState -> ()) -> NFData ProgramState
forall a. (a -> ()) -> NFData a
$crnf :: ProgramState -> ()
rnf :: ProgramState -> ()
NFData)

internalToExternal :: InternalState -> ProgramState
internalToExternal :: InternalState -> ProgramState
internalToExternal InternalState
s =
    ProgramState {
        -- Censor the literal value to avoid introducing dependencies on it. It's just for debugging.
        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,
        -- internalState = s, -- For debugging
        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 s) {
            literalValue = 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]

-- Conveniently get the state before a token id
getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState
getIncomingState :: CFGAnalysis -> Id -> Maybe ProgramState
getIncomingState CFGAnalysis
analysis Id
id = do
    (Node
start,Node
end) <- Id -> Map Id (Node, Node) -> Maybe (Node, Node)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
id (Map Id (Node, Node) -> Maybe (Node, Node))
-> Map Id (Node, Node) -> Maybe (Node, Node)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Node, Node)
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
<$> Node
-> Map Node (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
start (CFGAnalysis -> Map Node (ProgramState, ProgramState)
nodeToData CFGAnalysis
analysis)

-- Conveniently get the state after a token id
getOutgoingState :: CFGAnalysis -> Id -> Maybe ProgramState
getOutgoingState :: CFGAnalysis -> Id -> Maybe ProgramState
getOutgoingState CFGAnalysis
analysis Id
id = do
    (Node
start,Node
end) <- Id -> Map Id (Node, Node) -> Maybe (Node, Node)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
id (Map Id (Node, Node) -> Maybe (Node, Node))
-> Map Id (Node, Node) -> Maybe (Node, Node)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Node, Node)
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
<$> Node
-> Map Node (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
end (CFGAnalysis -> Map Node (ProgramState, ProgramState)
nodeToData CFGAnalysis
analysis)

-- Conveniently determine whether one node postdominates another,
-- i.e. whether 'target' always unconditionally runs after 'base'.
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
    (Node
_, Node
baseEnd) <- Id -> Map Id (Node, Node) -> Maybe (Node, Node)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
base (Map Id (Node, Node) -> Maybe (Node, Node))
-> Map Id (Node, Node) -> Maybe (Node, Node)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Node, Node)
tokenToRange CFGAnalysis
analysis
    (Node
targetStart, Node
_) <- Id -> Map Id (Node, Node) -> Maybe (Node, Node)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Id
target (Map Id (Node, Node) -> Maybe (Node, Node))
-> Map Id (Node, Node) -> Maybe (Node, Node)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Id (Node, Node)
tokenToRange CFGAnalysis
analysis
    Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Node
targetStart Node -> [Node] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CFGAnalysis -> Array Node [Node]
postDominators CFGAnalysis
analysis Array Node [Node] -> Node -> [Node]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Node
baseEnd)

-- See if any execution path results in the variable containing a state
variableMayHaveState :: ProgramState -> String -> CFVariableProp -> Maybe Bool
variableMayHaveState :: ProgramState -> String -> CFVariableProp -> Maybe Bool
variableMayHaveState ProgramState
state String
var CFVariableProp
property = do
    VariableState
value <- String -> Map String VariableState -> Maybe VariableState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
var (Map String VariableState -> Maybe VariableState)
-> Map String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ ProgramState -> Map String VariableState
variablesInScope ProgramState
state
    Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ (Set CFVariableProp -> Bool) -> Set (Set CFVariableProp) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CFVariableProp -> Set CFVariableProp -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member CFVariableProp
property) (Set (Set CFVariableProp) -> Bool)
-> Set (Set CFVariableProp) -> Bool
forall a b. (a -> b) -> a -> b
$ VariableState -> Set (Set CFVariableProp)
variableProperties VariableState
value

-- See if any execution path declares the variable an integer (declare -i).
variableMayBeDeclaredInteger :: ProgramState -> String -> Maybe Bool
variableMayBeDeclaredInteger ProgramState
state String
var = ProgramState -> String -> CFVariableProp -> Maybe Bool
variableMayHaveState ProgramState
state String
var CFVariableProp
CFVPInteger

-- See if any execution path suggests the variable may contain an integer value
variableMayBeAssignedInteger :: ProgramState -> String -> Maybe Bool
variableMayBeAssignedInteger ProgramState
state String
var = do
    VariableState
value <- String -> Map String VariableState -> Maybe VariableState
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
var (Map String VariableState -> Maybe VariableState)
-> Map String VariableState -> Maybe VariableState
forall a b. (a -> b) -> a -> b
$ ProgramState -> Map String VariableState
variablesInScope ProgramState
state
    Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ (VariableValue -> NumericalStatus
numericalStatus (VariableValue -> NumericalStatus)
-> VariableValue -> NumericalStatus
forall a b. (a -> b) -> a -> b
$ VariableState -> VariableValue
variableValue VariableState
value) NumericalStatus -> NumericalStatus -> Bool
forall a. Ord a => a -> a -> Bool
>= NumericalStatus
NumericalStatusMaybe

getDataForNode :: CFGAnalysis -> Node -> Maybe (ProgramState, ProgramState)
getDataForNode CFGAnalysis
analysis Node
node = Node
-> Map Node (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
node (Map Node (ProgramState, ProgramState)
 -> Maybe (ProgramState, ProgramState))
-> Map Node (ProgramState, ProgramState)
-> Maybe (ProgramState, ProgramState)
forall a b. (a -> b) -> a -> b
$ CFGAnalysis -> Map Node (ProgramState, ProgramState)
nodeToData CFGAnalysis
analysis

-- The current state of data flow at a point in the program, potentially as a diff
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 (Node -> InternalState -> ShowS
[InternalState] -> ShowS
InternalState -> String
(Node -> InternalState -> ShowS)
-> (InternalState -> String)
-> ([InternalState] -> ShowS)
-> Show InternalState
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> InternalState -> ShowS
showsPrec :: Node -> InternalState -> ShowS
$cshow :: InternalState -> String
show :: InternalState -> String
$cshowList :: [InternalState] -> ShowS
showList :: [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
$cfrom :: forall x. InternalState -> Rep InternalState x
from :: forall x. InternalState -> Rep InternalState x
$cto :: forall x. Rep InternalState x -> InternalState
to :: forall x. Rep InternalState x -> InternalState
Generic, InternalState -> ()
(InternalState -> ()) -> NFData InternalState
forall a. (a -> ()) -> NFData a
$crnf :: InternalState -> ()
rnf :: InternalState -> ()
NFData)

newInternalState :: InternalState
newInternalState = 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 = Just False
}

-- The default state we assume we get from the environment
createEnvironmentState :: InternalState
createEnvironmentState :: InternalState
createEnvironmentState = do
    (InternalState
 -> (InternalState -> InternalState) -> InternalState)
-> InternalState
-> [InternalState -> InternalState]
-> InternalState
forall b a. (b -> a -> b) -> b -> [a] -> b
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 {
            literalValue = Nothing,
            spaceStatus = SpaceStatusClean,
            numericalStatus = NumericalStatusUnknown
        }
    }
    integerVariableState :: VariableState
integerVariableState = VariableState
unknownVariableState {
        variableValue = unknownIntegerValue
    }


modified :: InternalState -> InternalState
modified InternalState
s = InternalState
s { sVersion = -1 }

insertGlobal :: String -> VariableState -> InternalState -> InternalState
insertGlobal :: String -> VariableState -> InternalState -> InternalState
insertGlobal String
name VariableState
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
    sGlobalValues = vmInsert name value $ sGlobalValues state
}

insertLocal :: String -> VariableState -> InternalState -> InternalState
insertLocal :: String -> VariableState -> InternalState -> InternalState
insertLocal String
name VariableState
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
    sLocalValues = vmInsert name value $ sLocalValues state
}

insertPrefix :: String -> VariableState -> InternalState -> InternalState
insertPrefix :: String -> VariableState -> InternalState -> InternalState
insertPrefix String
name VariableState
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
    sPrefixValues = vmInsert name value $ sPrefixValues state
}

insertFunction :: String -> FunctionValue -> InternalState -> InternalState
insertFunction :: String -> FunctionValue -> InternalState -> InternalState
insertFunction String
name FunctionValue
value InternalState
state = InternalState -> InternalState
modified InternalState
state {
    sFunctionTargets = vmInsert name value $ sFunctionTargets state
}

addProperties :: S.Set CFVariableProp -> VariableState -> VariableState
addProperties :: Set CFVariableProp -> VariableState -> VariableState
addProperties Set CFVariableProp
props VariableState
state = VariableState
state {
    variableProperties = S.map (S.union props) $ variableProperties state
}

removeProperties :: S.Set CFVariableProp -> VariableState -> VariableState
removeProperties :: Set CFVariableProp -> VariableState -> VariableState
removeProperties Set CFVariableProp
props VariableState
state = VariableState
state {
    variableProperties = 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 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 = Just $ set
}

-- Dependencies on values, e.g. "if there is a global variable named 'foo' without spaces"
-- This is used to see if the DFA of a function would result in the same state, so anything
-- that affects DFA must be tracked.
data StateDependency =
    -- Complete variable state
    DepState Scope String VariableState
    -- Only variable properties (we need properties but not values for x=1)
    | DepProperties Scope String VariableProperties
    -- Function definition
    | DepFunction String (S.Set FunctionDefinition)
    -- Whether invoking the node would result in recursion (i.e., is the function on the stack?)
    | DepIsRecursive Node Bool
    -- The set of commands that could have provided the exit code $?
    | DepExitCodes (S.Set Id)
    deriving (Node -> StateDependency -> ShowS
[StateDependency] -> ShowS
StateDependency -> String
(Node -> StateDependency -> ShowS)
-> (StateDependency -> String)
-> ([StateDependency] -> ShowS)
-> Show StateDependency
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> StateDependency -> ShowS
showsPrec :: Node -> StateDependency -> ShowS
$cshow :: StateDependency -> String
show :: StateDependency -> String
$cshowList :: [StateDependency] -> ShowS
showList :: [StateDependency] -> ShowS
Show, StateDependency -> StateDependency -> Bool
(StateDependency -> StateDependency -> Bool)
-> (StateDependency -> StateDependency -> Bool)
-> Eq StateDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateDependency -> StateDependency -> Bool
== :: StateDependency -> StateDependency -> Bool
$c/= :: StateDependency -> StateDependency -> Bool
/= :: 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
$ccompare :: StateDependency -> StateDependency -> Ordering
compare :: StateDependency -> StateDependency -> Ordering
$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
>= :: StateDependency -> StateDependency -> Bool
$cmax :: StateDependency -> StateDependency -> StateDependency
max :: StateDependency -> StateDependency -> StateDependency
$cmin :: StateDependency -> StateDependency -> StateDependency
min :: StateDependency -> StateDependency -> 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
$cfrom :: forall x. StateDependency -> Rep StateDependency x
from :: forall x. StateDependency -> Rep StateDependency x
$cto :: forall x. Rep StateDependency x -> StateDependency
to :: forall x. Rep StateDependency x -> StateDependency
Generic, StateDependency -> ()
(StateDependency -> ()) -> NFData StateDependency
forall a. (a -> ()) -> NFData a
$crnf :: StateDependency -> ()
rnf :: StateDependency -> ()
NFData)

-- A function definition, or lack thereof
data FunctionDefinition = FunctionUnknown | FunctionDefinition String Node Node
    deriving (Node -> FunctionDefinition -> ShowS
[FunctionDefinition] -> ShowS
FunctionDefinition -> String
(Node -> FunctionDefinition -> ShowS)
-> (FunctionDefinition -> String)
-> ([FunctionDefinition] -> ShowS)
-> Show FunctionDefinition
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> FunctionDefinition -> ShowS
showsPrec :: Node -> FunctionDefinition -> ShowS
$cshow :: FunctionDefinition -> String
show :: FunctionDefinition -> String
$cshowList :: [FunctionDefinition] -> ShowS
showList :: [FunctionDefinition] -> ShowS
Show, FunctionDefinition -> FunctionDefinition -> Bool
(FunctionDefinition -> FunctionDefinition -> Bool)
-> (FunctionDefinition -> FunctionDefinition -> Bool)
-> Eq FunctionDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionDefinition -> FunctionDefinition -> Bool
== :: FunctionDefinition -> FunctionDefinition -> Bool
$c/= :: FunctionDefinition -> FunctionDefinition -> Bool
/= :: 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
$ccompare :: FunctionDefinition -> FunctionDefinition -> Ordering
compare :: FunctionDefinition -> FunctionDefinition -> Ordering
$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
>= :: FunctionDefinition -> FunctionDefinition -> Bool
$cmax :: FunctionDefinition -> FunctionDefinition -> FunctionDefinition
max :: FunctionDefinition -> FunctionDefinition -> FunctionDefinition
$cmin :: FunctionDefinition -> FunctionDefinition -> FunctionDefinition
min :: FunctionDefinition -> FunctionDefinition -> 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
$cfrom :: forall x. FunctionDefinition -> Rep FunctionDefinition x
from :: forall x. FunctionDefinition -> Rep FunctionDefinition x
$cto :: forall x. Rep FunctionDefinition x -> FunctionDefinition
to :: forall x. Rep FunctionDefinition x -> FunctionDefinition
Generic, FunctionDefinition -> ()
(FunctionDefinition -> ()) -> NFData FunctionDefinition
forall a. (a -> ()) -> NFData a
$crnf :: FunctionDefinition -> ()
rnf :: FunctionDefinition -> ()
NFData)

-- The Set of places a command name can point (it's a Set to handle conditionally defined functions)
type FunctionValue = S.Set FunctionDefinition

-- Create an InternalState that fulfills the given dependencies
depsToState :: S.Set StateDependency -> InternalState
depsToState :: Set StateDependency -> InternalState
depsToState Set StateDependency
set = (InternalState -> StateDependency -> InternalState)
-> InternalState -> [StateDependency] -> InternalState
forall b a. (b -> a -> b) -> b -> [a] -> b
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
            -- State includes properties and more, so don't overwrite a state with properties
            DepProperties Scope
scope String
name Set (Set CFVariableProp)
props -> Bool
-> Scope
-> String
-> VariableState
-> InternalState
-> InternalState
insertIn Bool
False Scope
scope String
name VariableState
unknownVariableState { variableProperties = props } InternalState
state
            DepIsRecursive Node
_ 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)

            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

-- The information about the value of a single variable
data VariableValue = VariableValue {
    VariableValue -> Maybe String
literalValue :: Maybe String, -- TODO: For debugging. Remove me.
    VariableValue -> SpaceStatus
spaceStatus :: SpaceStatus,
    VariableValue -> NumericalStatus
numericalStatus :: NumericalStatus
}
    deriving (Node -> VariableValue -> ShowS
[VariableValue] -> ShowS
VariableValue -> String
(Node -> VariableValue -> ShowS)
-> (VariableValue -> String)
-> ([VariableValue] -> ShowS)
-> Show VariableValue
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> VariableValue -> ShowS
showsPrec :: Node -> VariableValue -> ShowS
$cshow :: VariableValue -> String
show :: VariableValue -> String
$cshowList :: [VariableValue] -> ShowS
showList :: [VariableValue] -> ShowS
Show, VariableValue -> VariableValue -> Bool
(VariableValue -> VariableValue -> Bool)
-> (VariableValue -> VariableValue -> Bool) -> Eq VariableValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VariableValue -> VariableValue -> Bool
== :: VariableValue -> VariableValue -> Bool
$c/= :: VariableValue -> VariableValue -> Bool
/= :: 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
$ccompare :: VariableValue -> VariableValue -> Ordering
compare :: VariableValue -> VariableValue -> Ordering
$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
>= :: VariableValue -> VariableValue -> Bool
$cmax :: VariableValue -> VariableValue -> VariableValue
max :: VariableValue -> VariableValue -> VariableValue
$cmin :: VariableValue -> VariableValue -> VariableValue
min :: VariableValue -> VariableValue -> 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
$cfrom :: forall x. VariableValue -> Rep VariableValue x
from :: forall x. VariableValue -> Rep VariableValue x
$cto :: forall x. Rep VariableValue x -> VariableValue
to :: forall x. Rep VariableValue x -> VariableValue
Generic, VariableValue -> ()
(VariableValue -> ()) -> NFData VariableValue
forall a. (a -> ()) -> NFData a
$crnf :: VariableValue -> ()
rnf :: VariableValue -> ()
NFData)

data VariableState = VariableState {
    VariableState -> VariableValue
variableValue :: VariableValue,
    VariableState -> Set (Set CFVariableProp)
variableProperties :: VariableProperties
}
    deriving (Node -> VariableState -> ShowS
[VariableState] -> ShowS
VariableState -> String
(Node -> VariableState -> ShowS)
-> (VariableState -> String)
-> ([VariableState] -> ShowS)
-> Show VariableState
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> VariableState -> ShowS
showsPrec :: Node -> VariableState -> ShowS
$cshow :: VariableState -> String
show :: VariableState -> String
$cshowList :: [VariableState] -> ShowS
showList :: [VariableState] -> ShowS
Show, VariableState -> VariableState -> Bool
(VariableState -> VariableState -> Bool)
-> (VariableState -> VariableState -> Bool) -> Eq VariableState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VariableState -> VariableState -> Bool
== :: VariableState -> VariableState -> Bool
$c/= :: VariableState -> VariableState -> Bool
/= :: 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
$ccompare :: VariableState -> VariableState -> Ordering
compare :: VariableState -> VariableState -> Ordering
$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
>= :: VariableState -> VariableState -> Bool
$cmax :: VariableState -> VariableState -> VariableState
max :: VariableState -> VariableState -> VariableState
$cmin :: VariableState -> VariableState -> VariableState
min :: VariableState -> VariableState -> 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
$cfrom :: forall x. VariableState -> Rep VariableState x
from :: forall x. VariableState -> Rep VariableState x
$cto :: forall x. Rep VariableState x -> VariableState
to :: forall x. Rep VariableState x -> VariableState
Generic, VariableState -> ()
(VariableState -> ()) -> NFData VariableState
forall a. (a -> ()) -> NFData a
$crnf :: VariableState -> ()
rnf :: VariableState -> ()
NFData)

-- Whether or not the value needs quoting (has spaces/globs), or we don't know
data SpaceStatus = SpaceStatusEmpty | SpaceStatusClean | SpaceStatusDirty deriving (Node -> SpaceStatus -> ShowS
[SpaceStatus] -> ShowS
SpaceStatus -> String
(Node -> SpaceStatus -> ShowS)
-> (SpaceStatus -> String)
-> ([SpaceStatus] -> ShowS)
-> Show SpaceStatus
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> SpaceStatus -> ShowS
showsPrec :: Node -> SpaceStatus -> ShowS
$cshow :: SpaceStatus -> String
show :: SpaceStatus -> String
$cshowList :: [SpaceStatus] -> ShowS
showList :: [SpaceStatus] -> ShowS
Show, SpaceStatus -> SpaceStatus -> Bool
(SpaceStatus -> SpaceStatus -> Bool)
-> (SpaceStatus -> SpaceStatus -> Bool) -> Eq SpaceStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpaceStatus -> SpaceStatus -> Bool
== :: SpaceStatus -> SpaceStatus -> Bool
$c/= :: SpaceStatus -> SpaceStatus -> Bool
/= :: 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
$ccompare :: SpaceStatus -> SpaceStatus -> Ordering
compare :: SpaceStatus -> SpaceStatus -> Ordering
$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
>= :: SpaceStatus -> SpaceStatus -> Bool
$cmax :: SpaceStatus -> SpaceStatus -> SpaceStatus
max :: SpaceStatus -> SpaceStatus -> SpaceStatus
$cmin :: SpaceStatus -> SpaceStatus -> SpaceStatus
min :: SpaceStatus -> SpaceStatus -> 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
$cfrom :: forall x. SpaceStatus -> Rep SpaceStatus x
from :: forall x. SpaceStatus -> Rep SpaceStatus x
$cto :: forall x. Rep SpaceStatus x -> SpaceStatus
to :: forall x. Rep SpaceStatus x -> SpaceStatus
Generic, SpaceStatus -> ()
(SpaceStatus -> ()) -> NFData SpaceStatus
forall a. (a -> ()) -> NFData a
$crnf :: SpaceStatus -> ()
rnf :: SpaceStatus -> ()
NFData)
--
-- Whether or not the value needs quoting (has spaces/globs), or we don't know
data NumericalStatus = NumericalStatusUnknown | NumericalStatusEmpty | NumericalStatusMaybe | NumericalStatusDefinitely deriving (Node -> NumericalStatus -> ShowS
[NumericalStatus] -> ShowS
NumericalStatus -> String
(Node -> NumericalStatus -> ShowS)
-> (NumericalStatus -> String)
-> ([NumericalStatus] -> ShowS)
-> Show NumericalStatus
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> NumericalStatus -> ShowS
showsPrec :: Node -> NumericalStatus -> ShowS
$cshow :: NumericalStatus -> String
show :: NumericalStatus -> String
$cshowList :: [NumericalStatus] -> ShowS
showList :: [NumericalStatus] -> ShowS
Show, NumericalStatus -> NumericalStatus -> Bool
(NumericalStatus -> NumericalStatus -> Bool)
-> (NumericalStatus -> NumericalStatus -> Bool)
-> Eq NumericalStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumericalStatus -> NumericalStatus -> Bool
== :: NumericalStatus -> NumericalStatus -> Bool
$c/= :: NumericalStatus -> NumericalStatus -> Bool
/= :: 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
$ccompare :: NumericalStatus -> NumericalStatus -> Ordering
compare :: NumericalStatus -> NumericalStatus -> Ordering
$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
>= :: NumericalStatus -> NumericalStatus -> Bool
$cmax :: NumericalStatus -> NumericalStatus -> NumericalStatus
max :: NumericalStatus -> NumericalStatus -> NumericalStatus
$cmin :: NumericalStatus -> NumericalStatus -> NumericalStatus
min :: NumericalStatus -> NumericalStatus -> 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
$cfrom :: forall x. NumericalStatus -> Rep NumericalStatus x
from :: forall x. NumericalStatus -> Rep NumericalStatus x
$cto :: forall x. Rep NumericalStatus x -> NumericalStatus
to :: forall x. Rep NumericalStatus x -> NumericalStatus
Generic, NumericalStatus -> ()
(NumericalStatus -> ()) -> NFData NumericalStatus
forall a. (a -> ()) -> NFData a
$crnf :: NumericalStatus -> ()
rnf :: NumericalStatus -> ()
NFData)

-- The set of possible sets of properties for this variable
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 :: VariableValue
variableValue = VariableValue
unknownVariableValue,
    variableProperties :: Set (Set CFVariableProp)
variableProperties = Set (Set CFVariableProp)
forall {a}. Set (Set a)
defaultProperties
}

unknownVariableValue :: VariableValue
unknownVariableValue = 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 = Just "",
    spaceStatus = SpaceStatusEmpty,
    numericalStatus = NumericalStatusEmpty
}

unsetVariableState :: VariableState
unsetVariableState = VariableState {
    variableValue :: VariableValue
variableValue = VariableValue
emptyVariableValue,
    variableProperties :: Set (Set CFVariableProp)
variableProperties = Set (Set CFVariableProp)
forall {a}. Set (Set a)
defaultProperties
}

mergeVariableState :: VariableState -> VariableState -> VariableState
mergeVariableState VariableState
a VariableState
b = VariableState {
    variableValue :: VariableValue
variableValue = VariableValue -> VariableValue -> VariableValue
mergeVariableValue (VariableState -> VariableValue
variableValue VariableState
a) (VariableState -> VariableValue
variableValue VariableState
b),
    variableProperties :: Set (Set CFVariableProp)
variableProperties = Set (Set CFVariableProp)
-> Set (Set CFVariableProp) -> Set (Set CFVariableProp)
forall a. Ord a => Set a -> Set a -> Set a
S.union (VariableState -> Set (Set CFVariableProp)
variableProperties VariableState
a) (VariableState -> Set (Set CFVariableProp)
variableProperties VariableState
b)
}

mergeVariableValue :: VariableValue -> VariableValue -> VariableValue
mergeVariableValue VariableValue
a VariableValue
b = 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

-- A VersionedMap is a Map that keeps an additional integer version to quickly determine if it has changed.
-- * Version -1 means it's unknown (possibly and presumably changed)
-- * Version 0 means it's empty
-- * Version N means it's equal to any other map with Version N (this is required but not enforced)
data VersionedMap k v = VersionedMap {
    forall k v. VersionedMap k v -> Integer
mapVersion :: Integer,
    forall k v. 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
$cfrom :: forall k v x. VersionedMap k v -> Rep (VersionedMap k v) x
from :: forall x. VersionedMap k v -> Rep (VersionedMap k v) x
$cto :: forall k v x. Rep (VersionedMap k v) x -> VersionedMap k v
to :: forall x. Rep (VersionedMap k v) x -> VersionedMap k v
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 -> ()
$crnf :: forall k v. (NFData k, NFData v) => VersionedMap k v -> ()
rnf :: VersionedMap k v -> ()
NFData)

-- This makes states more readable but inhibits copy-paste
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


-- A context with STRefs manually passed around to function.
-- This is done because it was dramatically much faster than any RWS type stack
data Ctx s = Ctx {
    -- The current node
    forall s. Ctx s -> STRef s Node
cNode :: STRef s Node,
    -- The current input state
    forall s. Ctx s -> STRef s InternalState
cInput :: STRef s InternalState,
    -- The current output state
    forall s. Ctx s -> STRef s InternalState
cOutput :: STRef s InternalState,

    -- The current functions/subshells stack
    forall s. Ctx s -> [StackEntry s]
cStack :: [StackEntry s],
    -- The input graph
    forall s. Ctx s -> CFGraph
cGraph :: CFGraph,
    -- An incrementing counter to version maps
    forall s. Ctx s -> STRef s Integer
cCounter :: STRef s Integer,
    -- A cache of input state dependencies to output effects
    forall s.
Ctx s -> STRef s (Map Node [(Set StateDependency, InternalState)])
cCache :: STRef s (M.Map Node [(S.Set StateDependency, InternalState)]),
    -- Whether the cache is enabled (see fallbackThreshold)
    forall s. Ctx s -> STRef s Bool
cEnableCache :: STRef s Bool,
    -- The states resulting from data flows per invocation path
    forall s.
Ctx s
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
cInvocations :: STRef s (M.Map [Node] (S.Set StateDependency, M.Map Node (InternalState, InternalState)))
}

-- Whenever a function (or subshell) is invoked, a value like this is pushed onto the stack
data StackEntry s = StackEntry {
    -- The entry point of this stack entry for the purpose of detecting recursion
    forall s. StackEntry s -> Node
entryPoint :: Node,
    -- Whether this is a function call (as opposed to a subshell)
    forall s. StackEntry s -> Bool
isFunctionCall :: Bool,
    -- The node where this entry point was invoked
    forall s. StackEntry s -> Node
callSite :: Node,
    -- A mutable set of dependencies we fetched from here or higher in the stack
    forall s. StackEntry s -> STRef s (Set StateDependency)
dependencies :: STRef s (S.Set StateDependency),
    -- The original input state for this stack entry
    forall s. 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
$c== :: forall s. StackEntry s -> StackEntry s -> Bool
== :: StackEntry s -> StackEntry s -> Bool
$c/= :: forall s. StackEntry s -> StackEntry s -> Bool
/= :: 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
$cfrom :: forall s x. StackEntry s -> Rep (StackEntry s) x
from :: forall x. StackEntry s -> Rep (StackEntry s) x
$cto :: forall s x. Rep (StackEntry s) x -> StackEntry s
to :: forall x. Rep (StackEntry s) x -> StackEntry s
Generic, StackEntry s -> ()
(StackEntry s -> ()) -> NFData (StackEntry s)
forall s. StackEntry s -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall s. StackEntry s -> ()
rnf :: StackEntry s -> ()
NFData)

#if MIN_VERSION_deepseq(1,4,2)
-- Our deepseq already has a STRef instance
#else
-- Older deepseq (for GHC < 8) lacks this instance
instance NFData (STRef s a) where
    rnf = (`seq` ())
#endif

-- Overwrite a base state with the contents of a diff state
-- This is unrelated to join/merge.
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 {
                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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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

-- Merge (aka Join) two states. This is monadic because it requires looking up
-- values from the current context. For example:
--
--   f() {
--     foo || x=2
--     HERE         # This merge requires looking up the value of $x in the parent frame
--   }
--   x=1
--   f
mergeState :: forall s. Ctx s -> InternalState -> InternalState -> ST s InternalState
mergeState :: forall s.
Ctx s -> InternalState -> InternalState -> ST s InternalState
mergeState Ctx s
ctx InternalState
a InternalState
b = do
    -- Kludge: we want `readVariable` & friends not to read from an intermediate state,
    --         so temporarily set a blank input.
    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 a. a -> ST s a
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 a. a -> ST s a
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 a. a -> ST s a
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 s.
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 s.
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 s.
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 s.
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 a. a -> ST s a
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 {
                    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)
                }

-- Merge a number of states, or return a default if there are no states
-- (it can't fold from newInternalState because this would be equivalent of adding a new input edge).
mergeStates :: forall s. Ctx s -> InternalState -> [InternalState] -> ST s InternalState
mergeStates :: forall s.
Ctx s -> InternalState -> [InternalState] -> ST s InternalState
mergeStates Ctx s
ctx InternalState
def [InternalState]
list =
    case [InternalState]
list of
        [] -> InternalState -> ST s InternalState
forall a. a -> ST s a
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

-- Merge two maps, key by key. If both maps have a key, the 'merger' is used.
-- If only one has the key, the 'reader' is used to fetch a second, and the two are merged as above.
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 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 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 a. a -> ST s a
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 a. a -> ST s a
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

-- Merge two Maybes, like mergeMaps for a single element
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 a. a -> m 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 a. a -> m 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 a. a -> m 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 a. a -> m a
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 {
    mapVersion :: Integer
mapVersion = -Integer
1,
    mapStorage :: Map k v
mapStorage = Map k v
map
}

-- Give a VersionedMap a version if it does not already have one.
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 a. a -> ST s a
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return VersionedMap k v
map {
            mapVersion = v
        }

-- Give an InternalState a version if it does not already have one.
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 a. a -> ST s a
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
state {
            sVersion = self,
            sGlobalValues = ssGlobalValues,
            sLocalValues = ssLocalValues,
            sFunctionTargets = ssFunctionTargets
        }

-- Like 'not null' but for 2+ elements
is2plus :: [a] -> Bool
is2plus :: forall a. [a] -> Bool
is2plus [a]
l = case [a]
l of
    a
_:a
_:[a]
_ -> Bool
True
    [a]
_ -> Bool
False

-- Use versions to see if two states are trivially identical
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

-- A manual slow path 'Eq' (it's not derived because it's part of the custom Eq instance)
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

-- Check if two VersionedMaps are trivially equal
vmIsQuickEqual :: VersionedMap k v -> VersionedMap k v -> Bool
vmIsQuickEqual :: forall k v. 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

-- A new, empty VersionedMap
vmEmpty :: VersionedMap k v
vmEmpty = VersionedMap {
    mapVersion :: Integer
mapVersion = Integer
0,
    mapStorage :: Map k v
mapStorage = Map k v
forall k a. Map k a
M.empty
}

-- Map.null for VersionedMaps
vmNull :: VersionedMap k v -> Bool
vmNull :: forall k v. 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)

-- Map.lookup for VersionedMaps
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

-- Map.insert for VersionedMaps
vmInsert :: k -> v -> VersionedMap k v -> VersionedMap k v
vmInsert k
key v
val VersionedMap k v
map = 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
}

-- Overwrite all keys in the first map with values from the second
vmPatch :: (Ord k) => VersionedMap k v -> VersionedMap k v -> VersionedMap k v
vmPatch :: forall k v.
Ord k =>
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 {
            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)
        }

-- Set a variable. This includes properties. Applies it to the appropriate scope.
writeVariable :: forall s. Ctx s -> String -> VariableState -> ST s ()
writeVariable :: forall s. 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
        -- Prefixed variables actually become local variables in the invoked function
        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
    (Set (Set CFVariableProp)
props, Scope
scope) <- Ctx s -> String -> ST s (Set (Set CFVariableProp), Scope)
forall s. Ctx s -> String -> ST s (Set (Set CFVariableProp), 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 -- Updates become local
    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 :: VariableValue
variableValue = VariableValue
val, variableProperties :: Set (Set CFVariableProp)
variableProperties = Set (Set CFVariableProp)
props }

updateGlobalValue :: Ctx s -> String -> VariableValue -> ST s ()
updateGlobalValue Ctx s
ctx String
name VariableValue
val = do
    Set (Set CFVariableProp)
props <- Ctx s -> String -> ST s (Set (Set CFVariableProp))
forall {s}. Ctx s -> String -> ST s (Set (Set CFVariableProp))
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 :: VariableValue
variableValue = VariableValue
val, variableProperties :: Set (Set CFVariableProp)
variableProperties = Set (Set CFVariableProp)
props }

updateLocalValue :: Ctx s -> String -> VariableValue -> ST s ()
updateLocalValue Ctx s
ctx String
name VariableValue
val = do
    Set (Set CFVariableProp)
props <- Ctx s -> String -> ST s (Set (Set CFVariableProp))
forall {s}. Ctx s -> String -> ST s (Set (Set CFVariableProp))
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 :: VariableValue
variableValue = VariableValue
val, variableProperties :: Set (Set CFVariableProp)
variableProperties = Set (Set CFVariableProp)
props }

updatePrefixValue :: Ctx s -> String -> VariableValue -> ST s ()
updatePrefixValue Ctx s
ctx String
name VariableValue
val = do
    -- Prefix variables don't inherit properties
    Ctx s -> String -> VariableState -> ST s ()
forall s. Ctx s -> String -> VariableState -> ST s ()
writePrefix Ctx s
ctx String
name VariableState { variableValue :: VariableValue
variableValue = VariableValue
val, variableProperties :: Set (Set CFVariableProp)
variableProperties = Set (Set CFVariableProp)
forall {a}. Set (Set a)
defaultProperties }


-- Look up a variable value, and also return its scope
readVariableWithScope :: forall s. Ctx s -> String -> ST s (VariableState, Scope)
readVariableWithScope :: forall s. 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

-- Look up the variable's properties. This can be done independently to avoid incurring a dependency on the value.
readVariablePropertiesWithScope :: forall s. Ctx s -> String -> ST s (VariableProperties, Scope)
readVariablePropertiesWithScope :: forall s. Ctx s -> String -> ST s (Set (Set CFVariableProp), Scope)
readVariablePropertiesWithScope Ctx s
ctx String
name = (InternalState
 -> String -> Maybe (Set (Set CFVariableProp), Scope))
-> (String -> (Set (Set CFVariableProp), Scope) -> StateDependency)
-> (Set (Set CFVariableProp), Scope)
-> Ctx s
-> String
-> ST s (Set (Set CFVariableProp), Scope)
forall {k} {v} {s}.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> String -> Maybe (Set (Set CFVariableProp), Scope)
get String -> (Set (Set CFVariableProp), Scope) -> StateDependency
dep (Set (Set CFVariableProp), 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 (Set (Set CFVariableProp), Scope)
get InternalState
s String
k = do
        (VariableState
val, Scope
scope) <- InternalState -> String -> Maybe (VariableState, Scope)
getVariableWithScope InternalState
s String
k
        (Set (Set CFVariableProp), Scope)
-> Maybe (Set (Set CFVariableProp), Scope)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableState -> Set (Set CFVariableProp)
variableProperties VariableState
val, Scope
scope)
    dep :: String -> (Set (Set CFVariableProp), Scope) -> StateDependency
dep String
k (Set (Set CFVariableProp)
val, Scope
scope) = Scope -> String -> Set (Set CFVariableProp) -> StateDependency
DepProperties Scope
scope String
k Set (Set CFVariableProp)
val

readVariableScope :: Ctx s -> String -> ST s Scope
readVariableScope Ctx s
ctx String
name = (Set (Set CFVariableProp), Scope) -> Scope
forall a b. (a, b) -> b
snd ((Set (Set CFVariableProp), Scope) -> Scope)
-> ST s (Set (Set CFVariableProp), Scope) -> ST s Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx s -> String -> ST s (Set (Set CFVariableProp), Scope)
forall s. Ctx s -> String -> ST s (Set (Set CFVariableProp), 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 a. a -> Maybe a
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 a. a -> Maybe a
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 a. a -> Maybe a
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 (Set (Set CFVariableProp))
readVariableProperties Ctx s
ctx String
name = (Set (Set CFVariableProp), Scope) -> Set (Set CFVariableProp)
forall a b. (a, b) -> a
fst ((Set (Set CFVariableProp), Scope) -> Set (Set CFVariableProp))
-> ST s (Set (Set CFVariableProp), Scope)
-> ST s (Set (Set CFVariableProp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx s -> String -> ST s (Set (Set CFVariableProp), Scope)
forall s. Ctx s -> String -> ST s (Set (Set CFVariableProp), 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 -- could come from the environment
    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 (Set (Set CFVariableProp))
readGlobalProperties Ctx s
ctx String
name = (InternalState -> String -> Maybe (Set (Set CFVariableProp)))
-> (String -> Set (Set CFVariableProp) -> StateDependency)
-> Set (Set CFVariableProp)
-> Ctx s
-> String
-> ST s (Set (Set CFVariableProp))
forall {k} {v} {s}.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStack InternalState -> String -> Maybe (Set (Set CFVariableProp))
get String -> Set (Set CFVariableProp) -> StateDependency
dep Set (Set CFVariableProp)
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 (Set (Set CFVariableProp))
get InternalState
s String
name = VariableState -> Set (Set CFVariableProp)
variableProperties (VariableState -> Set (Set CFVariableProp))
-> Maybe VariableState -> Maybe (Set (Set CFVariableProp))
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)
    -- This dependency will fail to match if it's shadowed by a local variable,
    -- such as in  x=1; f() { local -i x; declare -ag x; } because we'll look at
    -- x and find it to be local and not global. FIXME?
    dep :: String -> Set (Set CFVariableProp) -> StateDependency
dep String
k Set (Set CFVariableProp)
v = Scope -> String -> Set (Set CFVariableProp) -> StateDependency
DepProperties Scope
GlobalScope String
k Set (Set CFVariableProp)
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 -- can't come from the environment
    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

-- We only want to look up the local properties of the current function,
-- though preferably even if we're in a subshell.  FIXME?
readLocalProperties :: Ctx s -> String -> ST s (Set (Set CFVariableProp))
readLocalProperties Ctx s
ctx String
name = (Set (Set CFVariableProp), Scope) -> Set (Set CFVariableProp)
forall a b. (a, b) -> a
fst ((Set (Set CFVariableProp), Scope) -> Set (Set CFVariableProp))
-> ST s (Set (Set CFVariableProp), Scope)
-> ST s (Set (Set CFVariableProp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InternalState
 -> String -> Maybe (Set (Set CFVariableProp), Scope))
-> (String -> (Set (Set CFVariableProp), Scope) -> StateDependency)
-> (Set (Set CFVariableProp), Scope)
-> Ctx s
-> String
-> ST s (Set (Set CFVariableProp), Scope)
forall {k} {v} {s}.
(InternalState -> k -> Maybe v)
-> (k -> v -> StateDependency) -> v -> Ctx s -> k -> ST s v
lookupStackUntilFunction InternalState -> String -> Maybe (Set (Set CFVariableProp), Scope)
get String -> (Set (Set CFVariableProp), Scope) -> StateDependency
dep (Set (Set CFVariableProp), 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 (Set (Set CFVariableProp), b)
with b
tag m VariableState
f = do
        Set (Set CFVariableProp)
val <- VariableState -> Set (Set CFVariableProp)
variableProperties (VariableState -> Set (Set CFVariableProp))
-> m VariableState -> m (Set (Set CFVariableProp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m VariableState
f
        (Set (Set CFVariableProp), b) -> m (Set (Set CFVariableProp), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set (Set CFVariableProp)
val, b
tag)

    get :: InternalState -> String -> Maybe (Set (Set CFVariableProp), Scope)
get InternalState
s String
name = (Scope
-> Maybe VariableState -> Maybe (Set (Set CFVariableProp), Scope)
forall {m :: * -> *} {b}.
Monad m =>
b -> m VariableState -> m (Set (Set CFVariableProp), b)
with Scope
LocalScope (Maybe VariableState -> Maybe (Set (Set CFVariableProp), Scope))
-> Maybe VariableState -> Maybe (Set (Set CFVariableProp), 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 (Set (Set CFVariableProp), Scope)
-> Maybe (Set (Set CFVariableProp), Scope)
-> Maybe (Set (Set CFVariableProp), Scope)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Scope
-> Maybe VariableState -> Maybe (Set (Set CFVariableProp), Scope)
forall {m :: * -> *} {b}.
Monad m =>
b -> m VariableState -> m (Set (Set CFVariableProp), b)
with Scope
PrefixScope (Maybe VariableState -> Maybe (Set (Set CFVariableProp), Scope))
-> Maybe VariableState -> Maybe (Set (Set CFVariableProp), 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 -> (Set (Set CFVariableProp), Scope) -> StateDependency
dep String
k (Set (Set CFVariableProp)
val, Scope
scope) = Scope -> String -> Set (Set CFVariableProp) -> StateDependency
DepProperties Scope
scope String
k Set (Set CFVariableProp)
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

-- Look up each state on the stack until a value is found (or the default is used),
-- then add this value as a StateDependency.
lookupStack' :: forall s k v.
    -- Whether to stop at function boundaries
    Bool
    -- A function that maybe finds a value from a state
    -> (InternalState -> k -> Maybe v)
    -- A function that creates a dependency on what was found
    -> (k -> v -> StateDependency)
    -- A default value, if the value can't be found anywhere
    -> v
    -- Context
    -> Ctx s
    -- The key to look up
    -> k
    -- Returning the result
    -> ST s v
lookupStack' :: forall s k v.
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 a. a -> ST s a
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 a. a -> ST s a
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return v
def
    f (StackEntry s
s:[StackEntry s]
rest) = do
        -- Go up the stack until we find the value, and add
        -- a dependency on each state (including where it was found)
        v
res <- ST s v -> (v -> ST s v) -> Maybe v -> ST s v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([StackEntry s] -> ST s v
f [StackEntry s]
rest) v -> ST s v
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (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 a. a -> ST s a
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

-- Like lookupStack but without adding dependencies
peekStack :: (InternalState -> p -> Maybe b) -> b -> Ctx s -> p -> ST s b
peekStack InternalState -> p -> Maybe b
get b
def Ctx s
ctx p
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 -> p -> Maybe b
get InternalState
top p
key of
        Just b
v -> b -> ST s b
forall a. a -> ST s a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
def
    f (StackEntry s
s:[StackEntry s]
rest) =
        case InternalState -> p -> Maybe b
get (StackEntry s -> InternalState
forall s. StackEntry s -> InternalState
stackState StackEntry s
s) p
key of
            Just b
v -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
            Maybe b
Nothing -> [StackEntry s] -> m b
f [StackEntry s]
rest

-- Check if the current context fulfills a StateDependency if entering `entry`
fulfillsDependency :: Ctx s -> Node -> StateDependency -> ST s Bool
fulfillsDependency Ctx s
ctx Node
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 Set (Set CFVariableProp)
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 a. a -> ST s a
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 -> Set (Set CFVariableProp)
variableProperties VariableState
state Set (Set CFVariableProp) -> Set (Set CFVariableProp) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (Set CFVariableProp)
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
        -- Hack. Since we haven't pushed the soon-to-be invoked function on the stack,
        -- it won't be found by the normal check.
        DepIsRecursive Node
node Bool
val | Node
node Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
entry -> Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        DepIsRecursive Node
node Bool
val -> Bool -> ST s Bool
forall a. a -> ST s a
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 -> Node
forall s. StackEntry s -> Node
entryPoint StackEntry s
f Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
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 {p} {b} {s}.
(InternalState -> p -> Maybe b) -> b -> Ctx s -> p -> 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 ()
  --      _ -> error $ "Unknown dep " ++ show dep
  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 {p} {b} {s}.
(InternalState -> p -> Maybe b) -> b -> Ctx s -> p -> 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 {p} {b} {s}.
(InternalState -> p -> Maybe b) -> b -> Ctx s -> p -> 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

-- Check if the current context fulfills all StateDependencies
fulfillsDependencies :: Ctx s -> Node -> Set StateDependency -> ST s Bool
fulfillsDependencies Ctx s
ctx Node
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    f (StateDependency
dep:[StateDependency]
rest) = do
        Bool
res <- Ctx s -> Node -> StateDependency -> ST s Bool
forall {s}. Ctx s -> Node -> StateDependency -> ST s Bool
fulfillsDependency Ctx s
ctx Node
entry StateDependency
dep
        if Bool
res
            then [StateDependency] -> ST s Bool
f [StateDependency]
rest
            else Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- Create a brand new Ctx given a Control Flow Graph (CFG)
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 Node
node <- Node -> ST s (STRef s Node)
forall a s. a -> ST s (STRef s a)
newSTRef Node
forall a. HasCallStack => a
undefined
    STRef s (Map Node [(Set StateDependency, InternalState)])
cache <- Map Node [(Set StateDependency, InternalState)]
-> ST s (STRef s (Map Node [(Set StateDependency, InternalState)]))
forall a s. a -> ST s (STRef s a)
newSTRef Map Node [(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
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState)))
invocations <- Map
  [Node]
  (Set StateDependency, Map Node (InternalState, InternalState))
-> ST
     s
     (STRef
        s
        (Map
           [Node]
           (Set StateDependency, Map Node (InternalState, InternalState))))
forall a s. a -> ST s (STRef s a)
newSTRef Map
  [Node]
  (Set StateDependency, Map Node (InternalState, InternalState))
forall k a. Map k a
M.empty
    Ctx s -> ST s (Ctx s)
forall a. a -> ST s a
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 {
        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 Node
cNode = STRef s Node
node,
        cCache :: STRef s (Map Node [(Set StateDependency, InternalState)])
cCache = STRef s (Map Node [(Set StateDependency, InternalState)])
cache,
        cEnableCache :: STRef s Bool
cEnableCache = STRef s Bool
enableCache,
        cStack :: [StackEntry s]
cStack = [],
        cInvocations :: STRef
  s
  (Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState)))
cInvocations = STRef
  s
  (Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState)))
invocations,
        cGraph :: CFGraph
cGraph = CFGraph
g
    }

-- The next incrementing version for VersionedMaps
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n

-- Create a new StackEntry
newStackEntry :: Ctx s -> Node -> Bool -> ST s (StackEntry s)
newStackEntry Ctx s
ctx Node
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
    Node
callsite <- STRef s Node -> ST s Node
forall s a. STRef s a -> ST s a
readSTRef (STRef s Node -> ST s Node) -> STRef s Node -> ST s Node
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s Node
forall s. Ctx s -> STRef s Node
cNode Ctx s
ctx
    StackEntry s -> ST s (StackEntry s)
forall a. a -> ST s a
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 {
        entryPoint :: Node
entryPoint = Node
point,
        isFunctionCall :: Bool
isFunctionCall = Bool
isCall,
        callSite :: Node
callSite = Node
callsite,
        dependencies :: STRef s (Set StateDependency)
dependencies = STRef s (Set StateDependency)
deps,
        stackState :: InternalState
stackState = InternalState
state
    }

-- Call a function with a new stack entry on the stack
withNewStackFrame :: Ctx s
-> Node -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Node
node Bool
isCall Ctx s -> ST s a
f = do
    StackEntry s
newEntry <- Ctx s -> Node -> Bool -> ST s (StackEntry s)
forall {s}. Ctx s -> Node -> Bool -> ST s (StackEntry s)
newStackEntry Ctx s
ctx Node
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 Node
newNode <- Node -> ST s (STRef s Node)
forall a s. a -> ST s (STRef s a)
newSTRef Node
node
    let newCtx :: Ctx s
newCtx = Ctx s
ctx {
        cInput = newInput,
        cOutput = newOutput,
        cNode = newNode,
        cStack = newEntry : cStack ctx
    }
    a
x <- Ctx s -> ST s a
f Ctx s
newCtx

    {-
    deps <- readSTRef $ dependencies newEntry
    selfcheck <- fulfillsDependencies newCtx deps
    unless selfcheck $ error $ pleaseReport $ "Unmet stack dependencies on " ++ show (node, deps)
    -}

    (a, StackEntry s) -> ST s (a, StackEntry s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, StackEntry s
newEntry)

-- Check if invoking this function would be a recursive loop
-- (i.e. we already have the function on the stack)
wouldBeRecursive :: Ctx s -> Node -> ST s Bool
wouldBeRecursive Ctx s
ctx Node
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    f (StackEntry s
s:[StackEntry s]
rest) = do
        Bool
res <-
            if StackEntry s -> Node
forall s. StackEntry s -> Node
entryPoint StackEntry s
s Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
node
            then Bool -> ST s Bool
forall a. a -> ST s a
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
$ Node -> Bool -> StateDependency
DepIsRecursive Node
node Bool
res
        Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
res

-- The main DFA 'transfer' function, applying the effects of a node to the output state
transfer :: Ctx s -> CFNode -> ST s ()
transfer Ctx s
ctx CFNode
label =
  --traceShow ("Transferring", label) $
    case CFNode
label of
        CFNode
CFStructuralNode -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        CFEntryPoint String
_ -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        CFNode
CFImpliedExit -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        CFResolvedExit {} -> () -> ST s ()
forall a. a -> ST s a
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 Node
entry Node
exit -> Ctx s -> String -> Node -> Node -> ST s ()
forall {s} {p}. Ctx s -> p -> Node -> Node -> ST s ()
transferSubshell Ctx s
ctx String
reason Node
entry Node
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

        -- TODO
        CFSetBackgroundPid Id
_ -> () -> ST s ()
forall a. a -> ST s a
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 = vmEmpty }
--        _ -> error $ "Unknown " ++ show label


-- Transfer the effects of a subshell invocation. This is similar to a function call
-- to allow easily discarding the effects (otherwise the InternalState would have
-- to represent subshell depth, while this way it can simply use the function stack).
transferSubshell :: Ctx s -> p -> Node -> Node -> ST s ()
transferSubshell Ctx s
ctx p
reason Node
entry Node
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
-> Node
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
forall s.
Ctx s
-> Node
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
runCached Ctx s
ctx Node
entry (Node -> Node -> Ctx s -> ST s (Set StateDependency, InternalState)
forall {s}.
Node -> Node -> Ctx s -> ST s (Set StateDependency, InternalState)
f Node
entry Node
exit)
    InternalState
res <- STRef s InternalState -> ST s InternalState
forall s a. STRef s a -> ST s a
readSTRef STRef s InternalState
cout
    -- Clear subshell changes. TODO: track this to warn about modifications.
    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 = sExitCodes res
    }
  where
    f :: Node -> Node -> Ctx s -> ST s (Set StateDependency, InternalState)
f Node
entry Node
exit Ctx s
ctx = do
        (Map Node (InternalState, InternalState)
states, StackEntry s
frame) <- Ctx s
-> Node
-> Bool
-> (Ctx s -> ST s (Map Node (InternalState, InternalState)))
-> ST s (Map Node (InternalState, InternalState), StackEntry s)
forall {s} {a}.
Ctx s
-> Node -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Node
entry Bool
False ((Ctx s -> Node -> ST s (Map Node (InternalState, InternalState)))
-> Node -> Ctx s -> ST s (Map Node (InternalState, InternalState))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ctx s -> Node -> ST s (Map Node (InternalState, InternalState))
forall s.
Ctx s -> Node -> ST s (Map Node (InternalState, InternalState))
dataflow (Node -> Ctx s -> ST s (Map Node (InternalState, InternalState)))
-> Node -> Ctx s -> ST s (Map Node (InternalState, InternalState))
forall a b. (a -> b) -> a -> b
$ Node
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
$ Node
-> Map Node (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
exit Map Node (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
-> Node
-> Map Node (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
forall {s}.
Ctx s
-> Node
-> Map Node (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Node
entry Map Node (InternalState, InternalState)
states Set StateDependency
deps
        (Set StateDependency, InternalState)
-> ST s (Set StateDependency, InternalState)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set StateDependency
deps, InternalState
res)

-- Transfer the effects of executing a command, i.e. the merged union of all possible function definitions.
transferCommand :: Ctx s -> Maybe String -> ST s ()
transferCommand Ctx s
ctx Maybe String
Nothing = () -> ST s ()
forall a. a -> ST s a
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

-- Transfer a set of function definitions and merge the output states.
transferMultiple :: Ctx s -> [Ctx s -> ST s a] -> ST s ()
transferMultiple Ctx s
ctx [Ctx s -> ST s a]
funcs = do
    (String, Node) -> ST s ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
logVerbose (String
"Transferring set of ", [Ctx s -> ST s a] -> Node
forall a. [a] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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

-- Transfer the effects of a single function definition.
transferFunctionValue :: Ctx s -> FunctionDefinition -> ST s ()
transferFunctionValue Ctx s
ctx FunctionDefinition
funcVal =
    case FunctionDefinition
funcVal of
        FunctionDefinition
FunctionUnknown -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        FunctionDefinition String
name Node
entry Node
exit -> do
            Bool
isRecursive <- Ctx s -> Node -> ST s Bool
forall {s}. Ctx s -> Node -> ST s Bool
wouldBeRecursive Ctx s
ctx Node
entry
            if Bool
isRecursive
                then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO: Find a better strategy for recursion
                else Ctx s
-> Node
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
forall s.
Ctx s
-> Node
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
runCached Ctx s
ctx Node
entry (String
-> Node
-> Node
-> Ctx s
-> ST s (Set StateDependency, InternalState)
forall {p} {s}.
p
-> Node
-> Node
-> Ctx s
-> ST s (Set StateDependency, InternalState)
f String
name Node
entry Node
exit)
  where
    f :: p
-> Node
-> Node
-> Ctx s
-> ST s (Set StateDependency, InternalState)
f p
name Node
entry Node
exit Ctx s
ctx = do
        (Map Node (InternalState, InternalState)
states, StackEntry s
frame) <- Ctx s
-> Node
-> Bool
-> (Ctx s -> ST s (Map Node (InternalState, InternalState)))
-> ST s (Map Node (InternalState, InternalState), StackEntry s)
forall {s} {a}.
Ctx s
-> Node -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Node
entry Bool
True ((Ctx s -> Node -> ST s (Map Node (InternalState, InternalState)))
-> Node -> Ctx s -> ST s (Map Node (InternalState, InternalState))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ctx s -> Node -> ST s (Map Node (InternalState, InternalState))
forall s.
Ctx s -> Node -> ST s (Map Node (InternalState, InternalState))
dataflow (Node -> Ctx s -> ST s (Map Node (InternalState, InternalState)))
-> Node -> Ctx s -> ST s (Map Node (InternalState, InternalState))
forall a b. (a -> b) -> a -> b
$ Node
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 Node
-> Map Node (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
exit Map Node (InternalState, InternalState)
states of
                    Just (InternalState
input, InternalState
output) -> do
                        -- Discard local variables. TODO: track&retain variables declared local in previous scopes?
                        InternalState -> InternalState
modified InternalState
output { sLocalValues = vmEmpty }
                    Maybe (InternalState, InternalState)
Nothing -> do
                        -- e.g. f() { exit; }
                        InternalState
unreachableState
        Ctx s
-> Node
-> Map Node (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
forall {s}.
Ctx s
-> Node
-> Map Node (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Node
entry Map Node (InternalState, InternalState)
states Set StateDependency
deps
        (Set StateDependency, InternalState)
-> ST s (Set StateDependency, InternalState)
forall a. a -> ST s a
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

-- Register/save the result of a dataflow of a function.
-- At the end, all the different values from different flows are merged together.
registerFlowResult :: Ctx s
-> Node
-> Map Node (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Node
entry Map Node (InternalState, InternalState)
states Set StateDependency
deps = do
    -- This function is called in the context of a CFExecuteCommand and not its invoked function,
    -- so manually add the current node to the stack.
    Node
current <- STRef s Node -> ST s Node
forall s a. STRef s a -> ST s a
readSTRef (STRef s Node -> ST s Node) -> STRef s Node -> ST s Node
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s Node
forall s. Ctx s -> STRef s Node
cNode Ctx s
ctx
    let parents :: [Node]
parents = (StackEntry s -> Node) -> [StackEntry s] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map StackEntry s -> Node
forall s. StackEntry s -> Node
callSite ([StackEntry s] -> [Node]) -> [StackEntry s] -> [Node]
forall a b. (a -> b) -> a -> b
$ Ctx s -> [StackEntry s]
forall s. Ctx s -> [StackEntry s]
cStack Ctx s
ctx
    -- A unique path to this flow context. The specific value doesn't matter, as long as it's
    -- unique per invocation of the function. This is required so that 'x=1; f; x=2; f' won't
    -- overwrite each other.
    let path :: [Node]
path = Node
entry Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: Node
current Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
parents
    STRef
  s
  (Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState)))
-> (Map
      [Node]
      (Set StateDependency, Map Node (InternalState, InternalState))
    -> Map
         [Node]
         (Set StateDependency, Map Node (InternalState, InternalState)))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
forall s.
Ctx s
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
cInvocations Ctx s
ctx) ((Map
    [Node]
    (Set StateDependency, Map Node (InternalState, InternalState))
  -> Map
       [Node]
       (Set StateDependency, Map Node (InternalState, InternalState)))
 -> ST s ())
-> (Map
      [Node]
      (Set StateDependency, Map Node (InternalState, InternalState))
    -> Map
         [Node]
         (Set StateDependency, Map Node (InternalState, InternalState)))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ [Node]
-> (Set StateDependency, Map Node (InternalState, InternalState))
-> Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState))
-> Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert [Node]
path (Set StateDependency
deps, Map Node (InternalState, InternalState)
states)


-- Look up a node in the cache and see if the dependencies of any entries are matched.
-- In that case, reuse the previous result instead of doing a new data flow.
runCached :: forall s. Ctx s -> Node -> (Ctx s -> ST s (S.Set StateDependency, InternalState)) -> ST s ()
runCached :: forall s.
Ctx s
-> Node
-> (Ctx s -> ST s (Set StateDependency, InternalState))
-> ST s ()
runCached Ctx s
ctx Node
node Ctx s -> ST s (Set StateDependency, InternalState)
f = do
    Maybe InternalState
cache <- Ctx s -> Node -> ST s (Maybe InternalState)
forall s. Ctx s -> Node -> ST s (Maybe InternalState)
getCache Ctx s
ctx Node
node
    case Maybe InternalState
cache of
        Just InternalState
v -> do
            (String, Node) -> ST s ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
logInfo (String
"Running cached", Node
node)
            -- do { (deps, diff) <- f ctx; unless (v == diff) $ traceShowM ("Cache FAILED to match actual result", node, deps, diff); }
            Ctx s -> InternalState -> ST s ()
forall {s}. Ctx s -> InternalState -> ST s ()
patchOutputM Ctx s
ctx InternalState
v

        Maybe InternalState
Nothing -> do
            (String, Node) -> ST s ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
logInfo (String
"Cache failed", Node
node)
            (Set StateDependency
deps, InternalState
diff) <- Ctx s -> ST s (Set StateDependency, InternalState)
f Ctx s
ctx
            STRef s (Map Node [(Set StateDependency, InternalState)])
-> (Map Node [(Set StateDependency, InternalState)]
    -> Map Node [(Set StateDependency, InternalState)])
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (Ctx s -> STRef s (Map Node [(Set StateDependency, InternalState)])
forall s.
Ctx s -> STRef s (Map Node [(Set StateDependency, InternalState)])
cCache Ctx s
ctx) (([(Set StateDependency, InternalState)]
 -> [(Set StateDependency, InternalState)]
 -> [(Set StateDependency, InternalState)])
-> Node
-> [(Set StateDependency, InternalState)]
-> Map Node [(Set StateDependency, InternalState)]
-> Map Node [(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]
:(Node
-> [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
forall a. Node -> [a] -> [a]
take Node
cacheEntries [(Set StateDependency, InternalState)]
old)) Node
node [(Set StateDependency
deps,InternalState
diff)])
            (String, Node, Set StateDependency) -> ST s ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
logVerbose (String
"Recomputed cache for", Node
node, Set StateDependency
deps)
            -- do { f <- fulfillsDependencies ctx node deps; unless (f) $ traceShowM ("New dependencies FAILED to match", node, deps); }
            Ctx s -> InternalState -> ST s ()
forall {s}. Ctx s -> InternalState -> ST s ()
patchOutputM Ctx s
ctx InternalState
diff

-- Get a cached version whose dependencies are currently fulfilled, if any.
getCache :: forall s. Ctx s -> Node -> ST s (Maybe InternalState)
getCache :: forall s. Ctx s -> Node -> ST s (Maybe InternalState)
getCache Ctx s
ctx Node
node = do
    Map Node [(Set StateDependency, InternalState)]
cache <- STRef s (Map Node [(Set StateDependency, InternalState)])
-> ST s (Map Node [(Set StateDependency, InternalState)])
forall s a. STRef s a -> ST s a
readSTRef (STRef s (Map Node [(Set StateDependency, InternalState)])
 -> ST s (Map Node [(Set StateDependency, InternalState)]))
-> STRef s (Map Node [(Set StateDependency, InternalState)])
-> ST s (Map Node [(Set StateDependency, InternalState)])
forall a b. (a -> b) -> a -> b
$ Ctx s -> STRef s (Map Node [(Set StateDependency, InternalState)])
forall s.
Ctx s -> STRef s (Map Node [(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, Node, String, Node,
 Maybe [(Set StateDependency, InternalState)])
-> ST s ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
logVerbose (String
"Cache for", Node
node, String
"length", [(Set StateDependency, InternalState)] -> Node
forall a. [a] -> Node
forall (t :: * -> *) a. Foldable t => t a -> Node
length ([(Set StateDependency, InternalState)] -> Node)
-> [(Set StateDependency, InternalState)] -> Node
forall a b. (a -> b) -> a -> b
$ [(Set StateDependency, InternalState)]
-> Node
-> Map Node [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Node
node Map Node [(Set StateDependency, InternalState)]
cache, Node
-> Map Node [(Set StateDependency, InternalState)]
-> Maybe [(Set StateDependency, InternalState)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
node Map Node [(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)]
-> Node
-> Map Node [(Set StateDependency, InternalState)]
-> [(Set StateDependency, InternalState)]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] Node
node Map Node [(Set StateDependency, InternalState)]
cache
        else Maybe InternalState -> ST s (Maybe InternalState)
forall a. a -> ST s a
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 a. a -> ST s 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 -> Node -> Set StateDependency -> ST s Bool
forall {s}. Ctx s -> Node -> Set StateDependency -> ST s Bool
fulfillsDependencies Ctx s
ctx Node
node Set StateDependency
deps
        if Bool
match
            then Maybe a -> ST s (Maybe a)
forall a. a -> ST s 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

-- Transfer a single CFEffect to the output state.
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 Maybe Scope
scope String
name Set CFVariableProp
props ->
            case Maybe Scope
scope of
                Maybe Scope
Nothing -> 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
                Just 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
                Just 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
                Just Scope
PrefixScope -> do
                    -- Prefix values become local
                    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 Maybe Scope
scope String
name Set CFVariableProp
props ->
            case Maybe Scope
scope of
                Maybe Scope
Nothing -> 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
                Just 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
                Just 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
                Just Scope
PrefixScope -> do
                    -- Prefix values become local
                    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
            -- This should really just unset one or the other
            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 Node
entry Node
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 -> Node -> Node -> FunctionDefinition
FunctionDefinition String
name Node
entry Node
exit

        -- TODO
        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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        CFHintDefined String
name -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
--        _ -> error $ "Unknown effect " ++ show effect


-- Transfer the CFG's idea of a value into our VariableState
cfValueToVariableValue :: Ctx s -> CFValue -> ST s VariableValue
cfValueToVariableValue Ctx s
ctx CFValue
val =
    case CFValue
val of
        CFValue
CFValueArray -> VariableValue -> ST s VariableValue
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownVariableValue -- TODO: Track array status
        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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownIntegerValue
        CFValue
CFValueString -> VariableValue -> ST s VariableValue
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownVariableValue
        CFValue
CFValueUninitialized -> VariableValue -> ST s VariableValue
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
emptyVariableValue
--        _ -> error $ "Unknown value: " ++ show val
  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 a. a -> ST s a
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

-- A value can be computed from 0 or more parts, such as x="literal$y$z"
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 a. a -> ST s a
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue
unknownIntegerValue
        CFStringPart
CFStringUnknown -> VariableValue -> ST s VariableValue
forall a. a -> ST s a
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) -> Set (Set CFVariableProp) -> 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`) (Set (Set CFVariableProp) -> Bool)
-> Set (Set CFVariableProp) -> Bool
forall a b. (a -> b) -> a -> b
$ VariableState -> Set (Set CFVariableProp)
variableProperties VariableState
state -> VariableValue
unknownIntegerValue
            ()
_ -> VariableState -> VariableValue
variableValue VariableState
state

-- Append two VariableValues as if with z="$x$y"
appendVariableValue :: VariableValue -> VariableValue -> VariableValue
appendVariableValue :: VariableValue -> VariableValue -> VariableValue
appendVariableValue VariableValue
a VariableValue
b =
    VariableValue
unknownVariableValue {
        literalValue = liftM2 (++) (literalValue a) (literalValue b),
        spaceStatus = appendSpaceStatus (spaceStatus a) (spaceStatus b),
        numericalStatus = appendNumericalStatus (numericalStatus a) (numericalStatus 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 = Nothing,
    spaceStatus = SpaceStatusClean,
    numericalStatus = NumericalStatusDefinitely
}

literalToVariableValue :: String -> VariableValue
literalToVariableValue String
str = VariableValue
unknownVariableValue {
    literalValue = Just str,
    spaceStatus = literalToSpaceStatus str,
    numericalStatus = literalToNumericalStatus 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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res

-- Get the SpaceStatus for a literal string, i.e. if it needs quoting
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

-- Get the NumericalStatus for a literal string, i.e. whether it's an integer
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)

-- Classic, iterative Data Flow Analysis. See Wikipedia for a description of the process.
dataflow :: forall s. Ctx s -> Node -> ST s StateMap
dataflow :: forall s.
Ctx s -> Node -> ST s (Map Node (InternalState, InternalState))
dataflow Ctx s
ctx Node
entry = do
    STRef s (Set Node)
pending <- Set Node -> ST s (STRef s (Set Node))
forall a s. a -> ST s (STRef s a)
newSTRef (Set Node -> ST s (STRef s (Set Node)))
-> Set Node -> ST s (STRef s (Set Node))
forall a b. (a -> b) -> a -> b
$ Node -> Set Node
forall a. a -> Set a
S.singleton Node
entry
    STRef s (Map Node (InternalState, InternalState))
states <- Map Node (InternalState, InternalState)
-> ST s (STRef s (Map Node (InternalState, InternalState)))
forall a s. a -> ST s (STRef s a)
newSTRef (Map Node (InternalState, InternalState)
 -> ST s (STRef s (Map Node (InternalState, InternalState))))
-> Map Node (InternalState, InternalState)
-> ST s (STRef s (Map Node (InternalState, InternalState)))
forall a b. (a -> b) -> a -> b
$ Map Node (InternalState, InternalState)
forall k a. Map k a
M.empty
    -- Should probably be done via a stack frame instead
    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 Node)
-> STRef s (Map Node (InternalState, InternalState))
-> ST s ()
f Integer
iterationCount STRef s (Set Node)
pending STRef s (Map Node (InternalState, InternalState))
states
    STRef s (Map Node (InternalState, InternalState))
-> ST s (Map Node (InternalState, InternalState))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Map Node (InternalState, InternalState))
states
  where
    graph :: CFGraph
graph = Ctx s -> CFGraph
forall s. Ctx s -> CFGraph
cGraph Ctx s
ctx
    f :: Integer
-> STRef s (Set Node)
-> STRef s (Map Node (InternalState, InternalState))
-> ST s ()
f Integer
0 STRef s (Set Node)
_ STRef s (Map Node (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 Node)
pending STRef s (Map Node (InternalState, InternalState))
states = do
        Set Node
ps <- STRef s (Set Node) -> ST s (Set Node)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Set Node)
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
            -- This should never happen, but has historically been due to caching bugs.
            -- Try disabling the cache and continuing.
            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 Node -> Bool
forall a. Set a -> Bool
S.null Set Node
ps
            then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else do
                let (Node
next, Set Node
rest) = Set Node -> (Node, Set Node)
forall a. Set a -> (a, Set a)
S.deleteFindMin Set Node
ps
                [Node]
nexts <- STRef s (Map Node (InternalState, InternalState))
-> Node -> ST s [Node]
process STRef s (Map Node (InternalState, InternalState))
states Node
next
                STRef s (Set Node) -> Set Node -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Set Node)
pending (Set Node -> ST s ()) -> Set Node -> ST s ()
forall a b. (a -> b) -> a -> b
$ (Set Node -> Node -> Set Node) -> Set Node -> [Node] -> Set Node
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Node -> Set Node -> Set Node) -> Set Node -> Node -> Set Node
forall a b c. (a -> b -> c) -> b -> a -> c
flip Node -> Set Node -> Set Node
forall a. Ord a => a -> Set a -> Set a
S.insert) Set Node
rest [Node]
nexts
                Integer
-> STRef s (Set Node)
-> STRef s (Map Node (InternalState, InternalState))
-> ST s ()
f (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) STRef s (Set Node)
pending STRef s (Map Node (InternalState, InternalState))
states

    process :: STRef s (Map Node (InternalState, InternalState))
-> Node -> ST s [Node]
process STRef s (Map Node (InternalState, InternalState))
states Node
node = do
        Map Node (InternalState, InternalState)
stateMap <- STRef s (Map Node (InternalState, InternalState))
-> ST s (Map Node (InternalState, InternalState))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Map Node (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
$ (Node -> Maybe InternalState) -> [Node] -> [InternalState]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Node
c -> ((InternalState, InternalState) -> InternalState)
-> Maybe (InternalState, InternalState) -> Maybe InternalState
forall a b. (a -> b) -> Maybe a -> Maybe b
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
$ Node
-> Map Node (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
c Map Node (InternalState, InternalState)
stateMap) [Node]
incoming
        InternalState
input <-
            case [Node]
incoming of
                [] -> InternalState -> ST s InternalState
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
newInternalState
                [Node]
_ ->
                    case [InternalState]
inputs of
                        [] -> InternalState -> ST s InternalState
forall a. a -> ST s a
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 Node -> Node -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s Node
forall s. Ctx s -> STRef s Node
cNode Ctx s
ctx) (Node -> ST s ()) -> Node -> ST s ()
forall a b. (a -> b) -> a -> b
$ Node
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 [Node] -> Bool
forall a. [a] -> Bool
is2plus [Node]
outgoing
            then
                -- Version the state because we split and will probably merge later
                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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return InternalState
newOutput
        STRef s (Map Node (InternalState, InternalState))
-> Map Node (InternalState, InternalState) -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Map Node (InternalState, InternalState))
states (Map Node (InternalState, InternalState) -> ST s ())
-> Map Node (InternalState, InternalState) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Node
-> (InternalState, InternalState)
-> Map Node (InternalState, InternalState)
-> Map Node (InternalState, InternalState)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Node
node (InternalState
input, InternalState
result) Map Node (InternalState, InternalState)
stateMap
        case Node
-> Map Node (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
node Map Node (InternalState, InternalState)
stateMap of
            Maybe (InternalState, InternalState)
Nothing -> [Node] -> ST s [Node]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
outgoing
            Just (InternalState
oldInput, InternalState
oldOutput) ->
                if InternalState
oldOutput InternalState -> InternalState -> Bool
forall a. Eq a => a -> a -> Bool
== InternalState
result
                then [Node] -> ST s [Node]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                else [Node] -> ST s [Node]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
outgoing
      where
        (Adj CFEdge
incomingL, Node
_, CFNode
label, Adj CFEdge
outgoingL) = CFGraph -> Node -> (Adj CFEdge, Node, CFNode, Adj CFEdge)
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> Context a b
context CFGraph
graph (Node -> (Adj CFEdge, Node, CFNode, Adj CFEdge))
-> Node -> (Adj CFEdge, Node, CFNode, Adj CFEdge)
forall a b. (a -> b) -> a -> b
$ Node
node
        incoming :: [Node]
incoming = ((CFEdge, Node) -> Node) -> Adj CFEdge -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (CFEdge, Node) -> Node
forall a b. (a, b) -> b
snd (Adj CFEdge -> [Node]) -> Adj CFEdge -> [Node]
forall a b. (a -> b) -> a -> b
$ ((CFEdge, Node) -> Bool) -> Adj CFEdge -> Adj CFEdge
forall a. (a -> Bool) -> [a] -> [a]
filter (CFEdge, Node) -> 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 :: [Node]
outgoing = ((CFEdge, Node) -> Node) -> Adj CFEdge -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (CFEdge, Node) -> Node
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 -> Node -> Node -> ST s InternalState
runRoot Ctx s
ctx InternalState
env Node
entry Node
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 Node -> Node -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s Node
forall s. Ctx s -> STRef s Node
cNode Ctx s
ctx) (Node -> ST s ()) -> Node -> ST s ()
forall a b. (a -> b) -> a -> b
$ Node
entry
    (Map Node (InternalState, InternalState)
states, StackEntry s
frame) <- Ctx s
-> Node
-> Bool
-> (Ctx s -> ST s (Map Node (InternalState, InternalState)))
-> ST s (Map Node (InternalState, InternalState), StackEntry s)
forall {s} {a}.
Ctx s
-> Node -> Bool -> (Ctx s -> ST s a) -> ST s (a, StackEntry s)
withNewStackFrame Ctx s
ctx Node
entry Bool
False ((Ctx s -> ST s (Map Node (InternalState, InternalState)))
 -> ST s (Map Node (InternalState, InternalState), StackEntry s))
-> (Ctx s -> ST s (Map Node (InternalState, InternalState)))
-> ST s (Map Node (InternalState, InternalState), StackEntry s)
forall a b. (a -> b) -> a -> b
$ \Ctx s
c -> Ctx s -> Node -> ST s (Map Node (InternalState, InternalState))
forall s.
Ctx s -> Node -> ST s (Map Node (InternalState, InternalState))
dataflow Ctx s
c Node
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
-> Node
-> Map Node (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
forall {s}.
Ctx s
-> Node
-> Map Node (InternalState, InternalState)
-> Set StateDependency
-> ST s ()
registerFlowResult Ctx s
ctx Node
entry Map Node (InternalState, InternalState)
states Set StateDependency
deps
    -- Return the final state, used to invoke functions that were declared but not invoked
    InternalState -> ST s InternalState
forall a. a -> ST s a
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
$ Node
-> Map Node (InternalState, InternalState)
-> Maybe (InternalState, InternalState)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
exit Map Node (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
        (Node
entry, Node
exit) = (Node, Node) -> Id -> Map Id (Node, Node) -> (Node, Node)
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (String -> (Node, Node)
forall a. HasCallStack => String -> a
error (String -> (Node, Node)) -> String -> (Node, Node)
forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"Missing root") (Token -> Id
getId Token
t) (CFGResult -> Map Id (Node, Node)
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 -> Node -> Node -> ST s CFGAnalysis
forall {s}. CFGResult -> Node -> Node -> ST s CFGAnalysis
f CFGResult
cfg Node
entry Node
exit
  where
    f :: CFGResult -> Node -> Node -> ST s CFGAnalysis
f CFGResult
cfg Node
entry Node
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
        -- Do a dataflow analysis starting on the root node
        InternalState
exitState <- Ctx s -> InternalState -> Node -> Node -> ST s InternalState
forall {s}.
Ctx s -> InternalState -> Node -> Node -> ST s InternalState
runRoot Ctx s
ctx InternalState
env Node
entry Node
exit

        -- All nodes we've touched
        Map
  [Node]
  (Set StateDependency, Map Node (InternalState, InternalState))
invocations <- STRef
  s
  (Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState)))
-> ST
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
forall s a. STRef s a -> ST s a
readSTRef (STRef
   s
   (Map
      [Node]
      (Set StateDependency, Map Node (InternalState, InternalState)))
 -> ST
      s
      (Map
         [Node]
         (Set StateDependency, Map Node (InternalState, InternalState))))
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
-> ST
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
forall a b. (a -> b) -> a -> b
$ Ctx s
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
forall s.
Ctx s
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
cInvocations Ctx s
ctx
        let invokedNodes :: Map Node ()
invokedNodes = [(Node, ())] -> Map Node ()
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList ([(Node, ())] -> Map Node ()) -> [(Node, ())] -> Map Node ()
forall a b. (a -> b) -> a -> b
$ (Node -> (Node, ())) -> [Node] -> [(Node, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\Node
c -> (Node
c, ())) ([Node] -> [(Node, ())]) -> [Node] -> [(Node, ())]
forall a b. (a -> b) -> a -> b
$ Set Node -> [Node]
forall a. Set a -> [a]
S.toList (Set Node -> [Node]) -> Set Node -> [Node]
forall a b. (a -> b) -> a -> b
$ Map Node [(InternalState, InternalState)] -> Set Node
forall k a. Map k a -> Set k
M.keysSet (Map Node [(InternalState, InternalState)] -> Set Node)
-> Map Node [(InternalState, InternalState)] -> Set Node
forall a b. (a -> b) -> a -> b
$ Map [Node] (Map Node (InternalState, InternalState))
-> Map Node [(InternalState, InternalState)]
forall k v. Map k (Map Node v) -> Map Node [v]
groupByNode (Map [Node] (Map Node (InternalState, InternalState))
 -> Map Node [(InternalState, InternalState)])
-> Map [Node] (Map Node (InternalState, InternalState))
-> Map Node [(InternalState, InternalState)]
forall a b. (a -> b) -> a -> b
$ ((Set StateDependency, Map Node (InternalState, InternalState))
 -> Map Node (InternalState, InternalState))
-> Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState))
-> Map [Node] (Map Node (InternalState, InternalState))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Set StateDependency, Map Node (InternalState, InternalState))
-> Map Node (InternalState, InternalState)
forall a b. (a, b) -> b
snd Map
  [Node]
  (Set StateDependency, Map Node (InternalState, InternalState))
invocations

        -- Invoke all functions that were declared but not invoked
        -- This is so that we still get warnings for dead code
        -- (it's probably not actually dead, just used by a script that sources ours)
        let declaredFunctions :: Map Node FunctionDefinition
declaredFunctions = InternalState -> Map Node FunctionDefinition
getFunctionTargets InternalState
exitState
        let uninvoked :: Map Node FunctionDefinition
uninvoked = Map Node FunctionDefinition
-> Map Node () -> Map Node FunctionDefinition
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference Map Node FunctionDefinition
declaredFunctions Map Node ()
invokedNodes

        let stragglerInput :: InternalState
stragglerInput =
                (InternalState
env InternalState -> InternalState -> InternalState
`patchState` InternalState
exitState) {
                    -- We don't want `die() { exit $?; }; echo "Sourced"` to assume $? is always echo
                    sExitCodes = Nothing
                }

        Ctx s -> InternalState -> Map Node FunctionDefinition -> ST s ()
forall {s} {k}.
Ctx s -> InternalState -> Map k FunctionDefinition -> ST s ()
analyzeStragglers Ctx s
ctx InternalState
stragglerInput Map Node FunctionDefinition
uninvoked

        -- Now round up all the states from all data flows
        -- (FIXME: this excludes functions that were defined in straggling functions)
        Map
  [Node]
  (Set StateDependency, Map Node (InternalState, InternalState))
invocations <- STRef
  s
  (Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState)))
-> ST
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
forall s a. STRef s a -> ST s a
readSTRef (STRef
   s
   (Map
      [Node]
      (Set StateDependency, Map Node (InternalState, InternalState)))
 -> ST
      s
      (Map
         [Node]
         (Set StateDependency, Map Node (InternalState, InternalState))))
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
-> ST
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
forall a b. (a -> b) -> a -> b
$ Ctx s
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
forall s.
Ctx s
-> STRef
     s
     (Map
        [Node]
        (Set StateDependency, Map Node (InternalState, InternalState)))
cInvocations Ctx s
ctx
        Map Node (InternalState, InternalState)
invokedStates <- Ctx s
-> Map Node [(InternalState, InternalState)]
-> ST s (Map Node (InternalState, InternalState))
forall {s} {k}.
Ctx s
-> Map k [(InternalState, InternalState)]
-> ST s (Map k (InternalState, InternalState))
flattenByNode Ctx s
ctx (Map Node [(InternalState, InternalState)]
 -> ST s (Map Node (InternalState, InternalState)))
-> Map Node [(InternalState, InternalState)]
-> ST s (Map Node (InternalState, InternalState))
forall a b. (a -> b) -> a -> b
$ Map [Node] (Map Node (InternalState, InternalState))
-> Map Node [(InternalState, InternalState)]
forall k v. Map k (Map Node v) -> Map Node [v]
groupByNode (Map [Node] (Map Node (InternalState, InternalState))
 -> Map Node [(InternalState, InternalState)])
-> Map [Node] (Map Node (InternalState, InternalState))
-> Map Node [(InternalState, InternalState)]
forall a b. (a -> b) -> a -> b
$ ((Set StateDependency, Map Node (InternalState, InternalState))
 -> Map Node (InternalState, InternalState))
-> Map
     [Node]
     (Set StateDependency, Map Node (InternalState, InternalState))
-> Map [Node] (Map Node (InternalState, InternalState))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Set StateDependency, Map Node (InternalState, InternalState))
-> Map Node (InternalState, InternalState)
addDeps Map
  [Node]
  (Set StateDependency, Map Node (InternalState, InternalState))
invocations

        -- Fill in the map with unreachable states for anything we didn't get to
        let baseStates :: Map Node (InternalState, InternalState)
baseStates = [(Node, (InternalState, InternalState))]
-> Map Node (InternalState, InternalState)
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList ([(Node, (InternalState, InternalState))]
 -> Map Node (InternalState, InternalState))
-> [(Node, (InternalState, InternalState))]
-> Map Node (InternalState, InternalState)
forall a b. (a -> b) -> a -> b
$ (Node -> (Node, (InternalState, InternalState)))
-> [Node] -> [(Node, (InternalState, InternalState))]
forall a b. (a -> b) -> [a] -> [b]
map (\Node
c -> (Node
c, (InternalState
unreachableState, InternalState
unreachableState))) ([Node] -> [(Node, (InternalState, InternalState))])
-> [Node] -> [(Node, (InternalState, InternalState))]
forall a b. (a -> b) -> a -> b
$ (Node -> Node -> [Node]) -> (Node, Node) -> [Node]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Node -> Node -> [Node]
forall a. Enum a => a -> a -> [a]
enumFromTo ((Node, Node) -> [Node]) -> (Node, Node) -> [Node]
forall a b. (a -> b) -> a -> b
$ CFGraph -> (Node, Node)
forall a b. Gr a b -> (Node, Node)
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Node, Node)
nodeRange (CFGraph -> (Node, Node)) -> CFGraph -> (Node, Node)
forall a b. (a -> b) -> a -> b
$ CFGResult -> CFGraph
cfGraph CFGResult
cfg
        let allStates :: Map Node (InternalState, InternalState)
allStates = ((InternalState, InternalState)
 -> (InternalState, InternalState)
 -> (InternalState, InternalState))
-> Map Node (InternalState, InternalState)
-> Map Node (InternalState, InternalState)
-> Map Node (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 Node (InternalState, InternalState)
baseStates Map Node (InternalState, InternalState)
invokedStates

        -- Convert to external states
        let nodeToData :: Map Node (ProgramState, ProgramState)
nodeToData = ((InternalState, InternalState) -> (ProgramState, ProgramState))
-> Map Node (InternalState, InternalState)
-> Map Node (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 Node (InternalState, InternalState)
allStates

        CFGAnalysis -> ST s CFGAnalysis
forall a. a -> ST s a
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 Node (ProgramState, ProgramState)
nodeToData Map Node (ProgramState, ProgramState) -> CFGAnalysis -> CFGAnalysis
forall a b. NFData a => a -> b -> b
`deepseq` CFGAnalysis {
            graph :: CFGraph
graph = CFGResult -> CFGraph
cfGraph CFGResult
cfg,
            tokenToRange :: Map Id (Node, Node)
tokenToRange = CFGResult -> Map Id (Node, Node)
cfIdToRange CFGResult
cfg,
            tokenToNodes :: Map Id (Set Node)
tokenToNodes = CFGResult -> Map Id (Set Node)
cfIdToNodes CFGResult
cfg,
            nodeToData :: Map Node (ProgramState, ProgramState)
nodeToData = Map Node (ProgramState, ProgramState)
nodeToData,
            postDominators :: Array Node [Node]
postDominators = CFGResult -> Array Node [Node]
cfPostDominators CFGResult
cfg
        }


    -- Include the dependencies in the state of each function, e.g. if it depends on `x=foo` then add that.
    addDeps :: (S.Set StateDependency, M.Map Node (InternalState, InternalState)) -> M.Map Node (InternalState, InternalState)
    addDeps :: (Set StateDependency, Map Node (InternalState, InternalState))
-> Map Node (InternalState, InternalState)
addDeps (Set StateDependency
deps, Map Node (InternalState, InternalState)
m) = let base :: InternalState
base = Set StateDependency -> InternalState
depsToState Set StateDependency
deps in ((InternalState, InternalState) -> (InternalState, InternalState))
-> Map Node (InternalState, InternalState)
-> Map Node (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 Node (InternalState, InternalState)
m

    -- Collect all the states that each node has resulted in.
    groupByNode :: forall k v. M.Map k (M.Map Node v) -> M.Map Node [v]
    groupByNode :: forall k v. Map k (Map Node v) -> Map Node [v]
groupByNode Map k (Map Node v)
pathMap = ([v] -> [v] -> [v]) -> [(Node, [v])] -> Map Node [v]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
(++) ([(Node, [v])] -> Map Node [v]) -> [(Node, [v])] -> Map Node [v]
forall a b. (a -> b) -> a -> b
$ ((Node, v) -> (Node, [v])) -> [(Node, v)] -> [(Node, [v])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Node
k,v
v) -> (Node
k,[v
v])) ([(Node, v)] -> [(Node, [v])]) -> [(Node, v)] -> [(Node, [v])]
forall a b. (a -> b) -> a -> b
$ (Map Node v -> [(Node, v)]) -> [Map Node v] -> [(Node, v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Map Node v -> [(Node, v)]
forall k a. Map k a -> [(k, a)]
M.toList ([Map Node v] -> [(Node, v)]) -> [Map Node v] -> [(Node, v)]
forall a b. (a -> b) -> a -> b
$ Map k (Map Node v) -> [Map Node v]
forall k a. Map k a -> [a]
M.elems Map k (Map Node v)
pathMap

    -- Merge all the pre/post states for each node. This would have been a foldM if Map had one.
    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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> ST s a
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 a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
node, (InternalState, InternalState)
merged)

    -- Get the all the functions defined in an InternalState
    getFunctionTargets :: InternalState -> M.Map Node FunctionDefinition
    getFunctionTargets :: InternalState -> Map Node 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 (Node, FunctionDefinition)
getFunc FunctionDefinition
d =
                case FunctionDefinition
d of
                    FunctionDefinition String
_ Node
entry Node
_ -> (Node, FunctionDefinition) -> Maybe (Node, FunctionDefinition)
forall a. a -> Maybe a
Just (Node
entry, FunctionDefinition
d)
                    FunctionDefinition
_ -> Maybe (Node, FunctionDefinition)
forall a. Maybe a
Nothing
            funcs :: [(Node, FunctionDefinition)]
funcs = (FunctionDefinition -> Maybe (Node, FunctionDefinition))
-> [FunctionDefinition] -> [(Node, FunctionDefinition)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FunctionDefinition -> Maybe (Node, FunctionDefinition)
getFunc ([FunctionDefinition] -> [(Node, FunctionDefinition)])
-> [FunctionDefinition] -> [(Node, FunctionDefinition)]
forall a b. (a -> b) -> a -> b
$ FunctionValue -> [FunctionDefinition]
forall a. Set a -> [a]
S.toList FunctionValue
declaredFuncs
        in
            [(Node, FunctionDefinition)] -> Map Node FunctionDefinition
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Node, 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 Node
entry Node
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 Node -> Node -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (Ctx s -> STRef s Node
forall s. Ctx s -> STRef s Node
cNode Ctx s
ctx) Node
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
quickCheckResult :: forall prop. Testable prop => prop -> IO Result
runQuickCheckAll :: [(String, Property)] -> (Property -> IO Result) -> IO Bool
quickCheckAll