-- | Stepping Methods
module SSTG.Core.Execution.Stepping
    ( LiveState
    , DeadState
    , runBoundedBFS
    , runBoundedBFSLogged
    , runBoundedDFS
    , runBoundedDFSLogged
    ) where

import SSTG.Core.Execution.Rules
import SSTG.Core.Execution.Support

import qualified Data.Char as C
import qualified Data.List as L

-- | Custom hash function.
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

-- | A `State` that is not in value form yet, capable of being evaluated. A
-- list of `Rule`s is kept to denote reduction history.
type LiveState = ([Rule], State)

-- | A `State` that is in value form. A list of `Rule`s is kept to denote
-- reduction history.
type DeadState = ([Rule], State)

-- | Increment Status conditions, and shift the current / parent id as needed.
incStatus :: Maybe Int -> State -> State
incStatus mb_id state = state { state_status = status' }
  where
    status = state_status state
    status' = case mb_id of
                  Just int -> incStatusSteps (updateStatusId int status)
                  Nothing -> incStatusSteps status

-- | Given a list of `State` along with its list of past `Rule` reductions,
-- apply STG reduction. If reduction yields `Nothing`, simply return itself.
step :: ([Rule], State) -> [([Rule], State)]
step (hist, start) = case reduce start of
    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
    Nothing -> [(hist, start)]

-- | This is what we use the `<*>` over.
pass :: [LiveState] -> ([LiveState], [DeadState] -> [DeadState])
pass rule_states = (lives, \prev -> prev ++ deads)
  where
    stepped = concatMap step rule_states
    lives = filter (not . isStateValForm . snd) stepped
    deads = filter (isStateValForm . snd) stepped

-- | Run bounded breadth-first-search of the execution space with an `Int` to
-- denote the maximum number of steps to take.
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

-- | Run bounded breadth-first-search of the execution state with an `Int` to
-- denote the maximum number of steps to take. We keep a list to track
-- a history of all the execution snapshots. As it stands, this is currently
-- very NOT optimized.
runBoundedBFSLogged :: Int -> State -> [([LiveState], [DeadState])]
runBoundedBFSLogged n state = map (\i -> runBoundedBFS i state) [1..n]

-- | Currently @undefined@.
runBoundedDFS :: Int -> State -> ([LiveState], [DeadState])
runBoundedDFS = undefined

-- | Currently @undefined@.
runBoundedDFSLogged :: Int -> State -> [([LiveState], [DeadState])]
runBoundedDFSLogged = undefined