module Stg.Machine (
initialState,
evalStep,
evalUntil,
evalsUntil,
terminated,
HaltIf(..),
RunForSteps(..),
garbageCollect,
PerformGc(..),
GarbageCollectionAlgorithm,
triStateTracing,
twoSpaceCopying,
) where
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Stg.Language
import Stg.Machine.Evaluate
import Stg.Machine.GarbageCollection
import Stg.Machine.Types
initialState
:: Var
-> Program
-> StgState
initialState mainVar (Program binds) = initializedState
where
dummyLetInitial = StgState
{ stgCode = Eval (Let Recursive binds (AppF mainVar [])) mempty
, stgStack = mempty
, stgHeap = mempty
, stgGlobals = mempty
, stgSteps = 0
, stgInfo = Info StateInitial [] }
initializedState = case evalStep dummyLetInitial of
state | terminated state -> state
state@StgState
{ stgCode = Eval (AppF _mainVar []) (Locals locals) }
-> state
{ stgCode = Eval (AppF mainVar []) mempty
, stgSteps = 0
, stgGlobals = Globals locals
, stgInfo = Info StateInitial [] }
badState -> badState
{ stgInfo = Info (StateError InitialStateCreationFailed) [] }
data RunForSteps =
RunIndefinitely
| RunForMaxSteps Integer
newtype HaltIf = HaltIf (StgState -> Bool)
newtype PerformGc = PerformGc (StgState -> Maybe GarbageCollectionAlgorithm)
evalUntil
:: RunForSteps
-> HaltIf
-> PerformGc
-> StgState
-> StgState
evalUntil runForSteps halt performGc state
= NE.last (evalsUntil runForSteps halt performGc state)
data AttemptGc = GcPossible | SkipGc
deriving (Eq, Ord, Show)
evalsUntil
:: RunForSteps
-> HaltIf
-> PerformGc
-> StgState
-> NonEmpty StgState
evalsUntil runForSteps (HaltIf haltIf) (PerformGc performGc)
= step SkipGc
where
terminateWith :: a -> NonEmpty a
terminateWith = pure
isInitialOrTransition state = case stgInfo state of
Info StateTransition{} _ -> True
Info StateInitial _ -> True
_otherwise -> False
step _ state
| RunForMaxSteps maxSteps <- runForSteps
, stgSteps state >= maxSteps
= terminateWith (state { stgInfo = Info MaxStepsExceeded [] })
step _ state
| haltIf state
= terminateWith (state { stgInfo = Info HaltedByPredicate [] })
step gcPossible state
| isInitialOrTransition state
, gcPossible == GcPossible
, Just gcAlgorithm <- performGc state
= case garbageCollect gcAlgorithm state of
stateGc@StgState{stgInfo = Info GarbageCollection _} ->
state <| stateGc <| step SkipGc (evalStep stateGc)
_otherwise -> state <| step GcPossible (evalStep state)
step _ state
| isInitialOrTransition state
= state <| step GcPossible (evalStep state)
step _ state@StgState{ stgInfo = Info GarbageCollection _ }
= state <| step SkipGc (evalStep state)
step _ state = terminateWith state
terminated :: StgState -> Bool
terminated StgState{stgInfo = Info info _} = case info of
StateTransition{} -> False
StateInitial{} -> False
GarbageCollection{} -> False
_otherwise -> True