module Stg.Machine.Evaluate (
evalStep,
) where
import Data.Foldable
import qualified Data.Stack as S
import qualified Stg.Machine.Evaluate.ErrorTransitions as Error
import qualified Stg.Machine.Evaluate.ValidTransitions as Valid
import Stg.Machine.Types
evalStep :: StgState -> StgState
evalStep state = let state' = stgRule state
in state' { stgSteps = stgSteps state' + 1 }
rules :: [StgState -> Maybe StgState]
rules =
[ Valid.rule1_functionApp
, Valid.rule2_enterNonUpdatable
, Valid.rule3_let
, Valid.rule1819_casePrimopShortcut
, Valid.rule4_case
, Valid.rule5_constructorApp
, Valid.rule6_algebraicNormalMatch
, Valid.rule7_algebraicUnboundDefaultMatch
, Valid.rule8_algebraicBoundDefaultMatch
, Valid.rule9_primitiveLiteralEval
, Valid.rule10_primitiveLiteralApp
, Valid.rule11_primitiveNormalMatch
, Valid.rule12_primitiveBoundDefaultMatch
, Valid.rule13_primitiveUnboundDefaultMatch
, Valid.rule14_primop
, Valid.rule15_enterUpdatable
, Valid.rule16_missingReturnUpdate
, Valid.rule17a_missingArgUpdate
, Error.updatableClosureWithArgs
, Error.returnWithEmptyReturnStack
, Error.functionArgumentNotInScope
, Error.constructorArgumentNotInScope
, Error.primopArgumentNotInScope
, Error.algReturnToPrimAlts
, Error.primReturnToAlgAlts
, Error.enterBlackhole
, Error.updateClosureWithPrimitive
, Error.nonAlgPrimScrutinee
, Error.divisionByZero
, Error.badConArity ]
stgRule :: StgState -> StgState
stgRule state = case asum [ rule state | rule <- rules ] of
Nothing -> noRulesApply state
Just state' -> state'
noRulesApply :: StgState -> StgState
noRulesApply s = s { stgInfo = Info NoRulesApply detail }
where
detail = case stgStack s of
S.Empty -> []
_else -> [Detail_StackNotEmpty]