module SSTG.Core.Execution.Stepping
( LiveState
, DeadState
, runBoundedBFS
, runBoundedBFSLogged
, runBoundedDFS
, runBoundedDFSLogged
) where
import SSTG.Core.Language
import SSTG.Core.Execution.Rules
import qualified Data.Char as C
import qualified Data.List as L
hash :: [Rule] -> Int
hash rules = L.foldl' (\acc c -> (acc + p2 * C.ord c)`mod` p3) p1 str
where
str = concatMap show rules
p1 = 5381
p2 = 1009
p3 = 433494437
type LiveState = ([Rule], State)
type DeadState = ([Rule], State)
incStatus :: Maybe Int -> State -> State
incStatus mb_id state = state { state_status = status' }
where
status = state_status state
status' = case mb_id of
Nothing -> incStatusSteps status
Just id' -> incStatusSteps (updateStatusId id' status)
step :: ([Rule], State) -> [([Rule], State)]
step (hist, start) = case reduce start of
Nothing -> [(hist, start)]
Just (rule, results) ->
let trace = hist ++ [rule]
mb_id = if length results > 1
then Just (hash trace)
else Nothing
in map (\s -> (trace, incStatus mb_id s)) results
pass :: [LiveState] -> ([LiveState], [DeadState] -> [DeadState])
pass rule_states = (lives, \prev -> prev ++ deads)
where
stepped = concatMap step rule_states
lives = filter (not . isStateValueForm . snd) stepped
deads = filter (isStateValueForm . snd) stepped
runBoundedBFS :: Int -> State -> ([LiveState], [DeadState])
runBoundedBFS n state = (run execution) [([], state)]
where
passes = take n (repeat (SymbolicT { run = pass }))
start = SymbolicT { run = (\lives -> (lives, [])) }
execution = foldl (\acc s -> s <*> acc) start passes
runBoundedBFSLogged :: Int -> State -> [([LiveState], [DeadState])]
runBoundedBFSLogged n state = map (\i -> runBoundedBFS i state) [1..n]
runBoundedDFS :: Int -> State -> ([LiveState], [DeadState])
runBoundedDFS = undefined
runBoundedDFSLogged :: Int -> State -> [([LiveState], [DeadState])]
runBoundedDFSLogged = undefined