{-# 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 (>>>), followedBy, feedInput, 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 Data.Traversable (mapAccumL) import System.IO (Handle, hGetChar, hPutChar, hPutStrLn, stdin, stdout) import Text.Show.Functions () import Intcode.Machine (Machine(..), (!), addRelBase, jmp, memoryList, new, set) import Intcode.Opcode (Mode(..), Opcode(..), decode) ------------------------------------------------------------------------ -- 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 = hRunIO stdin stdout -- | 'runIO' generalized to an arbitrary input and output handle. hRunIO :: Handle {- ^ input handle -} -> Handle {- ^ output handle -} -> Effect {- ^ effect -} -> IO () hRunIO inH outH = go where go (Output o e) | 0 <= o, o < 0x80 = hPutChar outH (chr (fromIntegral o)) >> go e | otherwise = hPutStrLn outH ("<<" ++ show o ++ ">>") >> go e go (Input f) = go . f . fromIntegral . ord =<< hGetChar inH go Halt = return () go Fault = throwIO 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 = effectList . run . 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 inputs = case effect of Fault -> throw IntcodeFault Halt -> [] Output o e -> o : effectList e inputs Input f -> case inputs of x:xs -> effectList (f x) xs [] -> throw 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 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 mach = case step mach of Step mach' -> run mach' StepOut out mach' -> Output out (run mach') StepIn f -> Input (run . f) StepHalt -> Halt StepFault -> Fault -- | Compose two effects together. Outputs from first argument are -- used as inputs to the second effect. Composed effect halts when -- the second machine halts. -- -- >>> let mult n = Input (\i -> Output (i*n) Halt) -- >>> let add n = Input (\i -> Output (i+n) Halt) -- >>> effectList (mult 3 >>> add 1) [4] -- [13] (>>>) :: Effect -> Effect -> Effect _ >>> Fault = Fault _ >>> Halt = Halt x >>> Output o e = Output o (x >>> e) x >>> Input g = input x where input Fault = Fault input Halt = Fault input (Output o e) = e >>> g o input (Input f) = Input (input . f) infixl 9 >>> -- | Run first effect until it halts, then run the second effect. -- -- >>> Output 1 Halt `followedBy` Output 2 Halt -- Output 1 (Output 2 Halt) -- -- >>> Output 1 Halt `followedBy` Fault -- Output 1 Fault -- -- >>> Fault `followedBy` undefined -- Fault followedBy :: Effect -> Effect -> Effect followedBy Halt y = y followedBy Fault _ = Fault followedBy (Output o x) y = Output o (followedBy x y) followedBy (Input f) y = Input (\i -> followedBy (f i) y) -- | Provide an input to the first occurrence of an input request -- in a program effect. It is considered a fault if a program -- terminates before using the input. -- -- >>> feedInput [5,6] (Input (\x -> Input (\y -> Output (x*y) Halt))) -- Output 30 Halt -- -- >>> feedInput [7] Halt -- Fault feedInput :: [Int] {- ^ inputs -} -> Effect -> Effect feedInput [] e = e feedInput xs (Output o e) = Output o (feedInput xs e) feedInput (x:xs) (Input f) = feedInput xs (f x) feedInput _ _ = Fault ------------------------------------------------------------------------ -- Small-step semantics ------------------------------------------------------------------------ -- | Result of small-step semantics. data Step = Step !Machine -- ^ no effect | StepOut !Int !Machine -- ^ output | StepIn (Int -> Machine) -- ^ input | StepHalt -- ^ halt | StepFault -- ^ bad instruction deriving Show -- | Small-step semantics of virtual machine. step :: Machine -> Step step mach = case populateParams <$> decode (mach ! pc mach) of Nothing -> StepFault Just (pc', opcode) -> opcodeImpl opcode $! jmp pc' mach where populateParams :: Opcode Mode -> (Int, Opcode Int) populateParams = mapWithIndex toPtr (pc mach + 1) toPtr :: Int -> Mode -> Int toPtr i Imm = i toPtr i Abs = mach ! i toPtr i Rel = mach ! i + relBase mach -- | Apply a decoded opcode to the machine state. opcodeImpl :: Opcode Int {- ^ opcode with pointers -} -> Machine {- ^ machine with PC updated -} -> Step opcodeImpl o m = case o of Add a b c -> Step (set c (at a + at b) m) Mul a b c -> Step (set c (at a * at b) m) Inp a -> StepIn (\i -> set a i m) Out a -> StepOut (at a) m Jnz a b -> Step (if at a /= 0 then jmp (at b) m else m) Jz a b -> Step (if at a == 0 then jmp (at b) m else m) Lt a b c -> Step (set c (if at a < at b then 1 else 0) m) Eq a b c -> Step (set c (if at a == at b then 1 else 0) m) Arb a -> Step (addRelBase (at a) m) Hlt -> StepHalt where at i = m ! i mapWithIndex :: (Int -> a -> b) -> Int -> Opcode a -> (Int, Opcode b) mapWithIndex f = mapAccumL (\i a -> (i+1, f i a)) {-# INLINE mapWithIndex #-} ------------------------------------------------------------------------ -- Exceptions ------------------------------------------------------------------------ -- | Error when a machine fails to decode an instruction. data IntcodeFault = IntcodeFault deriving (Eq, Ord, Show, Read) instance Exception IntcodeFault where displayException _ = "intcode machine fault"