{-# Language Safe #-}
{-|
Module      : Intcode.Step
Description : Intcode small-step semantics
Copyright   : (c) Eric Mertens, 2019,2020
License     : ISC
Maintainer  : emertens@gmail.com

This module advances a 'Machine' by interpreting the opcode at the
current program counter.

-}
module Intcode.Step (Step(..), step) where

import Data.Traversable    (mapAccumL)
import Text.Show.Functions ()

import Intcode.Opcode      (Mode(..), Opcode(..), decode)
import Intcode.Machine     (Machine, (!), addRelBase, jmp, pc, relBase, set)

-- | Result of small-step semantics.
data Step
  = Step         !Machine    -- ^ update machine without output
  | StepOut !Int !Machine    -- ^ update machine with output
  | StepIn  (Int -> Machine) -- ^ machine blocked waiting for input
  | StepHalt                 -- ^ halt
  | StepFault                -- ^ bad instruction
  deriving Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Step -> ShowS
showsPrec :: Int -> Step -> ShowS
$cshow :: Step -> String
show :: Step -> String
$cshowList :: [Step] -> ShowS
showList :: [Step] -> ShowS
Show

-- | Small-step semantics of virtual machine.
step :: Machine -> Step
step :: Machine -> Step
step Machine
mach =
  case Opcode Mode -> (Int, Opcode Int)
populateParams (Opcode Mode -> (Int, Opcode Int))
-> Maybe (Opcode Mode) -> Maybe (Int, Opcode Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe (Opcode Mode)
decode (Machine
mach Machine -> Int -> Int
! Machine -> Int
pc Machine
mach) of
    Maybe (Int, Opcode Int)
Nothing            -> Step
StepFault
    Just (Int
pc', Opcode Int
opcode) -> Opcode Int -> Machine -> Step
opcodeImpl Opcode Int
opcode (Machine -> Step) -> Machine -> Step
forall a b. (a -> b) -> a -> b
$! Int -> Machine -> Machine
jmp Int
pc' Machine
mach

  where
    populateParams :: Opcode Mode -> (Int, Opcode Int)
    populateParams :: Opcode Mode -> (Int, Opcode Int)
populateParams = (Int -> Mode -> Int) -> Int -> Opcode Mode -> (Int, Opcode Int)
forall a b. (Int -> a -> b) -> Int -> Opcode a -> (Int, Opcode b)
mapWithIndex Int -> Mode -> Int
toPtr (Machine -> Int
pc Machine
mach Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    toPtr :: Int -> Mode -> Int
    toPtr :: Int -> Mode -> Int
toPtr Int
i Mode
Imm =        Int
i
    toPtr Int
i Mode
Abs = Machine
mach Machine -> Int -> Int
! Int
i
    toPtr Int
i Mode
Rel = Machine
mach Machine -> Int -> Int
! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Machine -> Int
relBase Machine
mach

-- | Apply a decoded opcode to the machine state.
opcodeImpl ::
  Opcode Int {- ^ opcode with pointers    -} ->
  Machine    {- ^ machine with PC updated -} ->
  Step
opcodeImpl :: Opcode Int -> Machine -> Step
opcodeImpl Opcode Int
o Machine
m =
  case Opcode Int
o of
    Add Int
a Int
b Int
c -> Machine -> Step
Step    (Int -> Int -> Machine -> Machine
set Int
c (Int -> Int
at Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
at Int
b) Machine
m)
    Mul Int
a Int
b Int
c -> Machine -> Step
Step    (Int -> Int -> Machine -> Machine
set Int
c (Int -> Int
at Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
at Int
b) Machine
m)
    Inp Int
a     -> (Int -> Machine) -> Step
StepIn  (\Int
i -> Int -> Int -> Machine -> Machine
set Int
a Int
i Machine
m)
    Out Int
a     -> Int -> Machine -> Step
StepOut (Int -> Int
at Int
a) Machine
m
    Jnz Int
a Int
b   -> Machine -> Step
Step    (if Int -> Int
at Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then Int -> Machine -> Machine
jmp (Int -> Int
at Int
b) Machine
m else Machine
m)
    Jz  Int
a Int
b   -> Machine -> Step
Step    (if Int -> Int
at Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> Machine -> Machine
jmp (Int -> Int
at Int
b) Machine
m else Machine
m)
    Lt  Int
a Int
b Int
c -> Machine -> Step
Step    (Int -> Int -> Machine -> Machine
set Int
c (if Int -> Int
at Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int -> Int
at Int
b then Int
1 else Int
0) Machine
m)
    Eq  Int
a Int
b Int
c -> Machine -> Step
Step    (Int -> Int -> Machine -> Machine
set Int
c (if Int -> Int
at Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
at Int
b then Int
1 else Int
0) Machine
m)
    Arb Int
a     -> Machine -> Step
Step    (Int -> Machine -> Machine
addRelBase (Int -> Int
at Int
a) Machine
m)
    Opcode Int
Hlt       -> Step
StepHalt
  where
    at :: Int -> Int
at Int
i = Machine
m Machine -> Int -> Int
! Int
i

mapWithIndex :: (Int -> a -> b) -> Int -> Opcode a -> (Int, Opcode b)
mapWithIndex :: forall a b. (Int -> a -> b) -> Int -> Opcode a -> (Int, Opcode b)
mapWithIndex Int -> a -> b
f = (Int -> a -> (Int, b)) -> Int -> Opcode a -> (Int, Opcode b)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\Int
i a
a -> (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int -> a -> b
f Int
i a
a))
{-# INLINE mapWithIndex #-}