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)
evalsUntil
:: RunForSteps
-> HaltIf
-> PerformGc
-> StgState
-> NonEmpty StgState
evalsUntil runForSteps (HaltIf haltIf) (PerformGc performGc)
= NE.fromList . go False
where
terminate = (:[])
go attemptGc = \case
state@StgState{ stgSteps = steps }
| RunForMaxSteps maxSteps <- runForSteps
, steps >= maxSteps
-> terminate (state { stgInfo = Info MaxStepsExceeded [] })
state | haltIf state
-> terminate (state { stgInfo = Info HaltedByPredicate [] })
state@StgState{ stgInfo = Info StateTransition{} _ }
| attemptGc
, Just algorithm <- performGc state
-> case garbageCollect algorithm state of
stateGc@StgState{stgInfo = Info GarbageCollection _} ->
state : stateGc : go False (evalStep stateGc)
_otherwise -> state : go True (evalStep state)
| otherwise -> state : go True (evalStep state)
state@StgState{ stgInfo = Info StateInitial _ }
| attemptGc
, Just algorithm <- performGc state
-> case garbageCollect algorithm state of
stateGc@StgState{stgInfo = Info GarbageCollection _} ->
state : stateGc : go False (evalStep stateGc)
_otherwise -> state : go True (evalStep state)
| otherwise -> state : go True (evalStep state)
state@StgState{ stgInfo = Info GarbageCollection _ }
-> state : go False (evalStep state)
state
-> terminate state
terminated :: StgState -> Bool
terminated StgState{stgInfo = Info info _} = case info of
StateTransition{} -> False
StateInitial{} -> False
GarbageCollection{} -> False
_otherwise -> True