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

Intcode is a virtual machine environment defined to have some arithmetic,
conditional jumps, and simple input and output facilities.

The instruction set is designed with independently selectable address modes for
each of its input and output parameters. The architecture is designed to be
simple to implement while powerful enough to write interesting programs
efficiently. The addition of a /relative base pointer/ makes it easy to
implement function calls in the language.

This Intcode architecture is defined across multiple
<https://adventofcode.com/2019/about Advent of Code 2019> tasks:
<https://adventofcode.com/2019/day/2 2>,
<https://adventofcode.com/2019/day/5 5>,
<https://adventofcode.com/2019/day/7 7>, and
<https://adventofcode.com/2019/day/9 9>

Common use modes:

* Machine construction: 'new'
* List functions: 'intcodeToList', 'effectList'
* Individual machine step processing: 'Step', 'step'
* Input/output interpretation: 'Effect', 'run'

Submodules:

* "Intcode.Machine" exposes the implementation details of the interpreter state.
* "Intcode.Parse" provides a parser for intcode text files.
* "Intcode.Opcode" provides types and the decoder for opcodes.

-}
module Intcode
  (
  -- * Simple list interface
  intcodeToList,

  -- * Machine state
  Machine, (!), new, set, memoryList,

  -- * Big-step semantics
  Effect(..), run,

  -- * Effect operations
  effectList,

  -- * Small-step semantics
  Step(..), step,

  -- * Exceptions
  IntcodeFault(..),

  -- * ASCII I/O interface
  runIO, hRunIO,

  ) where

import Control.Exception   (Exception(..), throw, throwIO)
import Data.Char           (chr, ord)
import System.IO           (Handle, hGetChar, hPutChar, hPutStrLn, stdin, stdout)

import Intcode.Machine     (Machine(..), (!), memoryList, new, set)
import Intcode.Step        (Step(..), step)

------------------------------------------------------------------------
-- ASCII I/O
------------------------------------------------------------------------

-- | Run intcode program using stdio. Non-ASCII outputs are printed as
-- integers.
--
-- Note that input and output is affected by handle buffering modes.
--
-- >>> runIO (run (new [104,72,104,101,104,108,104,108,104,111,104,33,104,10,99]))
-- Hello!
--
-- >>> runIO (run (new [104,-50,104,1000,99]))
-- <<-50>>
-- <<1000>>
runIO :: Effect -> IO ()
runIO :: Effect -> IO ()
runIO = Handle -> Handle -> Effect -> IO ()
hRunIO Handle
stdin Handle
stdout

-- | 'runIO' generalized to an arbitrary input and output handle.
hRunIO ::
  Handle {- ^ input handle  -} ->
  Handle {- ^ output handle -} ->
  Effect {- ^ effect        -} ->
  IO ()
hRunIO :: Handle -> Handle -> Effect -> IO ()
hRunIO Handle
inH Handle
outH = Effect -> IO ()
go
  where
    go :: Effect -> IO ()
go (Output Int
o Effect
e)
      | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
o, Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80 = Handle -> Char -> IO ()
hPutChar Handle
outH (Int -> Char
chr (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o)) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Effect -> IO ()
go Effect
e
      | Bool
otherwise        = Handle -> String -> IO ()
hPutStrLn Handle
outH (String
"<<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">>") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Effect -> IO ()
go Effect
e
    go (Input Int -> Effect
f)         = Effect -> IO ()
go (Effect -> IO ()) -> (Char -> Effect) -> Char -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Effect
f (Int -> Effect) -> (Char -> Int) -> Char -> Effect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> IO ()) -> IO Char -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO Char
hGetChar Handle
inH
    go Effect
Halt              = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go Effect
Fault             = IntcodeFault -> IO ()
forall e a. Exception e => e -> IO a
throwIO IntcodeFault
IntcodeFault

------------------------------------------------------------------------
-- High-level interface
------------------------------------------------------------------------

-- | Run a given memory image as a list transducer.
--
-- Use 'effectList' when you want to provide a specific 'Effect'.
--
-- Throws: 'IntcodeFault' when machine faults or too few inputs are provided.
--
--
-- >>> intcodeToList [3,12,6,12,15,1,13,14,13,4,13,99,-1,0,1,9] <$> [[0],[10]]
-- [[0],[1]]
--
-- >>> intcodeToList [3,3,1105,-1,9,1101,0,0,12,4,12,99,1] <$> [[0],[10]]
-- [[0],[1]]
--
-- >>> :{
-- >>> intcodeToList
-- >>>   [3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31,
-- >>>    1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104,
-- >>>    999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99]
-- >>> <$> [[7],[8],[9]]
-- >>> :}
-- [[999],[1000],[1001]]
intcodeToList ::
  [Int] {- ^ initial memory -} ->
  [Int] {- ^ inputs         -} ->
  [Int] {- ^ outputs        -}
intcodeToList :: [Int] -> [Int] -> [Int]
intcodeToList = Effect -> [Int] -> [Int]
effectList (Effect -> [Int] -> [Int])
-> ([Int] -> Effect) -> [Int] -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Machine -> Effect
run (Machine -> Effect) -> ([Int] -> Machine) -> [Int] -> Effect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Machine
new

-- | Evaluate a program's effect as a function from a list of
-- inputs to a list of outputs.
--
-- Throws: 'IntcodeFault' when machine faults or too few inputs are provided.
effectList ::
  Effect {- ^ program effect -} ->
  [Int]  {- ^ inputs         -} ->
  [Int]  {- ^ outputs        -}
effectList :: Effect -> [Int] -> [Int]
effectList Effect
effect [Int]
inputs =
  case Effect
effect of
    Effect
Fault      -> IntcodeFault -> [Int]
forall a e. Exception e => e -> a
throw IntcodeFault
IntcodeFault
    Effect
Halt       -> []
    Output Int
o Effect
e -> Int
o Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Effect -> [Int] -> [Int]
effectList Effect
e [Int]
inputs
    Input Int -> Effect
f    ->
      case [Int]
inputs of
        Int
x:[Int]
xs -> Effect -> [Int] -> [Int]
effectList (Int -> Effect
f Int
x) [Int]
xs
        []   -> IntcodeFault -> [Int]
forall a e. Exception e => e -> a
throw IntcodeFault
IntcodeFault

------------------------------------------------------------------------
-- Big-step semantics
------------------------------------------------------------------------

-- | Possible effects from running a machine
data Effect
  = Output !Int Effect    -- ^ Output an integer
  | Input (Int -> Effect) -- ^ Input an integer
  | Halt                  -- ^ Halt execution
  | Fault                 -- ^ Execution failure
  deriving Int -> Effect -> String -> String
[Effect] -> String -> String
Effect -> String
(Int -> Effect -> String -> String)
-> (Effect -> String)
-> ([Effect] -> String -> String)
-> Show Effect
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Effect -> String -> String
showsPrec :: Int -> Effect -> String -> String
$cshow :: Effect -> String
show :: Effect -> String
$cshowList :: [Effect] -> String -> String
showList :: [Effect] -> String -> String
Show

-- | Big-step semantics of virtual machine. The implementation details
-- of 'Machine' are abstracted away and the program behavior can be
-- observed by interpreting the various 'Effect' constructors.
--
-- >>> run (new [1102,34915192,34915192,7,4,7,99,0])
-- Output 1219070632396864 Halt
--
-- >>> run (new [3,1,99])
-- Input <function>
run :: Machine -> Effect
run :: Machine -> Effect
run Machine
mach =
  case Machine -> Step
step Machine
mach of
    Step Machine
mach'        -> Machine -> Effect
run Machine
mach'
    StepOut Int
out Machine
mach' -> Int -> Effect -> Effect
Output Int
out (Machine -> Effect
run Machine
mach')
    StepIn Int -> Machine
f          -> (Int -> Effect) -> Effect
Input (Machine -> Effect
run (Machine -> Effect) -> (Int -> Machine) -> Int -> Effect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Machine
f)
    Step
StepHalt          -> Effect
Halt
    Step
StepFault         -> Effect
Fault

------------------------------------------------------------------------
-- Exceptions
------------------------------------------------------------------------

-- | Error when a machine fails to decode an instruction.
data IntcodeFault = IntcodeFault
  deriving (IntcodeFault -> IntcodeFault -> Bool
(IntcodeFault -> IntcodeFault -> Bool)
-> (IntcodeFault -> IntcodeFault -> Bool) -> Eq IntcodeFault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntcodeFault -> IntcodeFault -> Bool
== :: IntcodeFault -> IntcodeFault -> Bool
$c/= :: IntcodeFault -> IntcodeFault -> Bool
/= :: IntcodeFault -> IntcodeFault -> Bool
Eq, Eq IntcodeFault
Eq IntcodeFault =>
(IntcodeFault -> IntcodeFault -> Ordering)
-> (IntcodeFault -> IntcodeFault -> Bool)
-> (IntcodeFault -> IntcodeFault -> Bool)
-> (IntcodeFault -> IntcodeFault -> Bool)
-> (IntcodeFault -> IntcodeFault -> Bool)
-> (IntcodeFault -> IntcodeFault -> IntcodeFault)
-> (IntcodeFault -> IntcodeFault -> IntcodeFault)
-> Ord IntcodeFault
IntcodeFault -> IntcodeFault -> Bool
IntcodeFault -> IntcodeFault -> Ordering
IntcodeFault -> IntcodeFault -> IntcodeFault
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IntcodeFault -> IntcodeFault -> Ordering
compare :: IntcodeFault -> IntcodeFault -> Ordering
$c< :: IntcodeFault -> IntcodeFault -> Bool
< :: IntcodeFault -> IntcodeFault -> Bool
$c<= :: IntcodeFault -> IntcodeFault -> Bool
<= :: IntcodeFault -> IntcodeFault -> Bool
$c> :: IntcodeFault -> IntcodeFault -> Bool
> :: IntcodeFault -> IntcodeFault -> Bool
$c>= :: IntcodeFault -> IntcodeFault -> Bool
>= :: IntcodeFault -> IntcodeFault -> Bool
$cmax :: IntcodeFault -> IntcodeFault -> IntcodeFault
max :: IntcodeFault -> IntcodeFault -> IntcodeFault
$cmin :: IntcodeFault -> IntcodeFault -> IntcodeFault
min :: IntcodeFault -> IntcodeFault -> IntcodeFault
Ord, Int -> IntcodeFault -> String -> String
[IntcodeFault] -> String -> String
IntcodeFault -> String
(Int -> IntcodeFault -> String -> String)
-> (IntcodeFault -> String)
-> ([IntcodeFault] -> String -> String)
-> Show IntcodeFault
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> IntcodeFault -> String -> String
showsPrec :: Int -> IntcodeFault -> String -> String
$cshow :: IntcodeFault -> String
show :: IntcodeFault -> String
$cshowList :: [IntcodeFault] -> String -> String
showList :: [IntcodeFault] -> String -> String
Show, ReadPrec [IntcodeFault]
ReadPrec IntcodeFault
Int -> ReadS IntcodeFault
ReadS [IntcodeFault]
(Int -> ReadS IntcodeFault)
-> ReadS [IntcodeFault]
-> ReadPrec IntcodeFault
-> ReadPrec [IntcodeFault]
-> Read IntcodeFault
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS IntcodeFault
readsPrec :: Int -> ReadS IntcodeFault
$creadList :: ReadS [IntcodeFault]
readList :: ReadS [IntcodeFault]
$creadPrec :: ReadPrec IntcodeFault
readPrec :: ReadPrec IntcodeFault
$creadListPrec :: ReadPrec [IntcodeFault]
readListPrec :: ReadPrec [IntcodeFault]
Read)

instance Exception IntcodeFault where
  displayException :: IntcodeFault -> String
displayException IntcodeFault
_ = String
"intcode machine fault"