content: {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE TypeApplications #-}
  
  module RunCmm
    ( evalGraph
    )
  where
  
  -- Using a `ControlTestMonad` to provide observations,
  -- simulate the execution of a `CmmGraph`.
  
  import Prelude hiding (succ)
  
  import GHC.Cmm
  import GHC.Cmm.Dataflow.Block
  import GHC.Cmm.Dataflow.Graph
  import GHC.Cmm.Dataflow.Label
  import GHC.Cmm.Switch
  import GHC.Utils.Panic
  
  import ControlTestMonad
  
  evalGraph :: forall stmt exp m .
               ControlTestMonad stmt exp m
              => (Label -> Block CmmNode O O -> stmt)
              -> (Label -> CmmExpr -> exp)
              -> CmmGraph
              -> m ()
  evalGraph stmt exp g = run (g_entry g)
    where GMany NothingO blockmap NothingO = g_graph g
          run :: Label -> m ()
          run label = do
            takeAction @stmt @exp (stmt label (actionOf label))
            case lastNode (blockOf label) of
              CmmBranch l -> run l
              CmmCondBranch e t f _ -> do
                        b <- evalPredicate @stmt @exp (exp label e)
                        run (if b then t else f)
              CmmSwitch e targets -> do
                        i <- evalEnum @stmt @exp (exp label e) $
                             extendRight $ switchTargetsRange targets
                        run $ labelIn i targets
  
              CmmCall { cml_cont = Just l } -> run l
              CmmCall { cml_cont = Nothing } -> return ()
              CmmForeignCall { succ = l } -> run l
  
          blockOf lbl =
               mapFindWithDefault (panic "GHC.Cmm.ControlFlow.Run.eval") lbl blockmap
          actionOf lbl = middle
              where (_, middle, _) = blockSplit $ blockOf lbl
  
  
  
  -- | Adapt between different representations of ranges
  extendRight :: Integral n => (n, n) -> (n, n)
  extendRight (lo, hi) = (lo, hi + 1)
  
  labelIn :: Integer -> SwitchTargets -> Label
  labelIn i targets =
      case [lbl | (j, lbl) <- switchTargetsCases targets, j == i]
        of [lbl] -> lbl
           [] -> case switchTargetsDefault targets of
                   Just lbl -> lbl
                   Nothing -> panic "GHC.Cmm.ControlFlow.Run.labelIn: no default"
           (_ : _ : _) -> panic "GHC.Cmm.ControlFlow.Run: too many matches"
  