├── .ghcid ├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── doctests.hs ├── intcode.cabal └── src ├── Intcode.hs └── Intcode ├── Machine.hs ├── Opcode.hs ├── Parse.hs └── Step.hs /.ghcid: -------------------------------------------------------------------------------- 1 | --command="cabal v2-repl --repl-options=-fno-code --repl-options=-fno-break-on-exception --repl-options=-fno-break-on-error --repl-options=-v1 --repl-options=-ferror-spans --repl-options=-j --repl-options=-Wall" 2 | -------------------------------------------------------------------------------- /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci '--distribution=jammy' 'github' 'intcode.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.19.20240708 12 | # 13 | # REGENDATA ("0.19.20240708",["--distribution=jammy","github","intcode.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | - push 18 | - pull_request 19 | jobs: 20 | linux: 21 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 22 | runs-on: ubuntu-20.04 23 | timeout-minutes: 24 | 60 25 | container: 26 | image: buildpack-deps:jammy 27 | continue-on-error: ${{ matrix.allow-failure }} 28 | strategy: 29 | matrix: 30 | include: 31 | - compiler: ghc-9.10.1 32 | compilerKind: ghc 33 | compilerVersion: 9.10.1 34 | setup-method: ghcup 35 | allow-failure: false 36 | - compiler: ghc-9.8.2 37 | compilerKind: ghc 38 | compilerVersion: 9.8.2 39 | setup-method: ghcup 40 | allow-failure: false 41 | - compiler: ghc-9.6.6 42 | compilerKind: ghc 43 | compilerVersion: 9.6.6 44 | setup-method: ghcup 45 | allow-failure: false 46 | fail-fast: false 47 | steps: 48 | - name: apt 49 | run: | 50 | apt-get update 51 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 52 | mkdir -p "$HOME/.ghcup/bin" 53 | curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" 54 | chmod a+x "$HOME/.ghcup/bin/ghcup" 55 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 56 | "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 57 | env: 58 | HCKIND: ${{ matrix.compilerKind }} 59 | HCNAME: ${{ matrix.compiler }} 60 | HCVER: ${{ matrix.compilerVersion }} 61 | - name: Set PATH and environment variables 62 | run: | 63 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 64 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 65 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 66 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 67 | HCDIR=/opt/$HCKIND/$HCVER 68 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 69 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 70 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 71 | echo "HC=$HC" >> "$GITHUB_ENV" 72 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 73 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 74 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 75 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 76 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 77 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 78 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 79 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 80 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 81 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 82 | env: 83 | HCKIND: ${{ matrix.compilerKind }} 84 | HCNAME: ${{ matrix.compiler }} 85 | HCVER: ${{ matrix.compilerVersion }} 86 | - name: env 87 | run: | 88 | env 89 | - name: write cabal config 90 | run: | 91 | mkdir -p $CABAL_DIR 92 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 125 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 126 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 127 | rm -f cabal-plan.xz 128 | chmod a+x $HOME/.cabal/bin/cabal-plan 129 | cabal-plan --version 130 | - name: checkout 131 | uses: actions/checkout@v4 132 | with: 133 | path: source 134 | - name: initial cabal.project for sdist 135 | run: | 136 | touch cabal.project 137 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 138 | cat cabal.project 139 | - name: sdist 140 | run: | 141 | mkdir -p sdist 142 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 143 | - name: unpack 144 | run: | 145 | mkdir -p unpacked 146 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 147 | - name: generate cabal.project 148 | run: | 149 | PKGDIR_intcode="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/intcode-[0-9.]*')" 150 | echo "PKGDIR_intcode=${PKGDIR_intcode}" >> "$GITHUB_ENV" 151 | rm -f cabal.project cabal.project.local 152 | touch cabal.project 153 | touch cabal.project.local 154 | echo "packages: ${PKGDIR_intcode}" >> cabal.project 155 | echo "package intcode" >> cabal.project 156 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 157 | cat >> cabal.project <> cabal.project.local 160 | cat cabal.project 161 | cat cabal.project.local 162 | - name: dump install plan 163 | run: | 164 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 165 | cabal-plan 166 | - name: restore cache 167 | uses: actions/cache/restore@v4 168 | with: 169 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 170 | path: ~/.cabal/store 171 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 172 | - name: install dependencies 173 | run: | 174 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 175 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 176 | - name: build w/o tests 177 | run: | 178 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 179 | - name: build 180 | run: | 181 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 182 | - name: tests 183 | run: | 184 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 185 | - name: cabal check 186 | run: | 187 | cd ${PKGDIR_intcode} || false 188 | ${CABAL} -vnormal check 189 | - name: haddock 190 | run: | 191 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 192 | - name: unconstrained build 193 | run: | 194 | rm -f cabal.project.local 195 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 196 | - name: save cache 197 | uses: actions/cache/save@v4 198 | if: always() 199 | with: 200 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 201 | path: ~/.cabal/store 202 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | dist-*/ 3 | .HTF/ 4 | log/ 5 | .cabal-sandbox/ 6 | .stack-work/ 7 | cabal-dev 8 | *# 9 | *.aux 10 | *.bundle 11 | *.chi 12 | *.chs.h 13 | *.dSYM 14 | *.dylib 15 | *.dyn_hi 16 | *.dyn_o 17 | *.eventlog 18 | *.hi 19 | *.hp 20 | *.o 21 | *.a 22 | *.prof 23 | *.so 24 | *~ 25 | .*.swo 26 | .*.swp 27 | .DS_Store 28 | .hpc 29 | .hsenv 30 | TAGS 31 | cabal.project.local 32 | cabal.sandbox.config 33 | codex.tags 34 | docs 35 | stack.yaml 36 | tags 37 | wiki 38 | wip 39 | .ghc.environment.* 40 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for intcode 2 | 3 | ## 0.4.0.0 4 | * Add `Intcode.Step` 5 | 6 | ## 0.3.0.0 7 | * Split machine-state and opcodes into separate modules. 8 | * Add `Intcode.Parse` 9 | * Add `Intcode.hRunIO` 10 | 11 | ## 0.2.0.0 12 | * Rename 'intCodeToList' to 'intcodeToList' 13 | 14 | ## 0.1.0.0 15 | * Initial release 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019 Eric Mertens 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose 4 | with or without fee is hereby granted, provided that the above copyright notice 5 | and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS 11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 13 | THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Intcode Interpreter 2 | 3 | [![Hackage](https://img.shields.io/hackage/v/intcode.svg)](https://hackage.haskell.org/package/intcode) [![Build Status](https://secure.travis-ci.org/glguy/intcode.png?branch=master)](http://travis-ci.org/glguy/intcode) 4 | 5 | Implementation of the Intcode virtual machine as defined by 6 | [Advent of Code 2019](https://adventofcode.com/2019). 7 | 8 | This implementation provides an efficient, pure implementation 9 | of the interpreter and exposes multiple levels of abstraction 10 | to make it easy to use in a variety of situations. 11 | 12 | This implementation is derived from my puzzle solutions 13 | [glguy/advent2019](https://github.com/glguy/advent2019). 14 | Example uses include 15 | [Day13.hs](https://github.com/glguy/advent2019/blob/master/execs/Day13.hs) 16 | and 17 | [Day15.hs](https://github.com/glguy/advent2019/blob/master/execs/Day15.hs). 18 | -------------------------------------------------------------------------------- /doctests.hs: -------------------------------------------------------------------------------- 1 | import Test.DocTest 2 | main :: IO () 3 | main = doctest ["-isrc", "Intcode", "Intcode.Machine", "Intcode.Opcode", "Intcode.Parse"] 4 | -------------------------------------------------------------------------------- /intcode.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | 3 | name: intcode 4 | version: 0.4.0.0 5 | synopsis: Advent of Code 2019 intcode interpreter 6 | category: Compilers/Interpreters 7 | license: ISC 8 | license-file: LICENSE 9 | author: Eric Mertens 10 | maintainer: emertens@gmail.com 11 | copyright: 2019 Eric Mertens 12 | build-type: Simple 13 | homepage: https://github.com/glguy/intcode 14 | bug-reports: https://github.com/glguy/intcode/issues 15 | Tested-With: GHC == {9.6.6, 9.8.2, 9.10.1} 16 | 17 | description: 18 | Implementation of the Intcode virtual machine as defined by 19 | Advent of Code . 20 | . 21 | This implementation provides an efficient, pure implementation 22 | of the interpreter and exposes multiple levels of abstraction 23 | to make it easy to use in a variety of situations. 24 | 25 | extra-doc-files: 26 | CHANGELOG.md 27 | README.md 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/glguy/intcode 32 | 33 | library 34 | hs-source-dirs: src 35 | default-language: Haskell2010 36 | 37 | exposed-modules: 38 | Intcode 39 | Intcode.Machine 40 | Intcode.Opcode 41 | Intcode.Parse 42 | Intcode.Step 43 | 44 | build-depends: 45 | base >= 4.12 && < 4.22, 46 | containers ^>= {0.6, 0.7}, 47 | primitive ^>= {0.8, 0.9}, 48 | 49 | test-suite doctests 50 | type: exitcode-stdio-1.0 51 | main-is: doctests.hs 52 | default-language: Haskell2010 53 | ghc-options: -threaded 54 | build-depends: 55 | base >= 4.12 && < 4.22, 56 | containers, 57 | primitive, 58 | doctest ^>= 0.23, 59 | -------------------------------------------------------------------------------- /src/Intcode.hs: -------------------------------------------------------------------------------- 1 | {-# Language Safe #-} 2 | {-| 3 | Module : Intcode 4 | Description : Intcode interpreter 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | Intcode is a virtual machine environment defined to have some arithmetic, 10 | conditional jumps, and simple input and output facilities. 11 | 12 | The instruction set is designed with independently selectable address modes for 13 | each of its input and output parameters. The architecture is designed to be 14 | simple to implement while powerful enough to write interesting programs 15 | efficiently. The addition of a /relative base pointer/ makes it easy to 16 | implement function calls in the language. 17 | 18 | This Intcode architecture is defined across multiple 19 | tasks: 20 | , 21 | , 22 | , and 23 | 24 | 25 | Common use modes: 26 | 27 | * Machine construction: 'new' 28 | * List functions: 'intcodeToList', 'effectList' 29 | * Individual machine step processing: 'Step', 'step' 30 | * Input/output interpretation: 'Effect', 'run' 31 | 32 | Submodules: 33 | 34 | * "Intcode.Machine" exposes the implementation details of the interpreter state. 35 | * "Intcode.Parse" provides a parser for intcode text files. 36 | * "Intcode.Opcode" provides types and the decoder for opcodes. 37 | 38 | -} 39 | module Intcode 40 | ( 41 | -- * Simple list interface 42 | intcodeToList, 43 | 44 | -- * Machine state 45 | Machine, (!), new, set, memoryList, 46 | 47 | -- * Big-step semantics 48 | Effect(..), run, 49 | 50 | -- * Effect operations 51 | effectList, 52 | 53 | -- * Small-step semantics 54 | Step(..), step, 55 | 56 | -- * Exceptions 57 | IntcodeFault(..), 58 | 59 | -- * ASCII I/O interface 60 | runIO, hRunIO, 61 | 62 | ) where 63 | 64 | import Control.Exception (Exception(..), throw, throwIO) 65 | import Data.Char (chr, ord) 66 | import System.IO (Handle, hGetChar, hPutChar, hPutStrLn, stdin, stdout) 67 | 68 | import Intcode.Machine (Machine(..), (!), memoryList, new, set) 69 | import Intcode.Step (Step(..), step) 70 | 71 | ------------------------------------------------------------------------ 72 | -- ASCII I/O 73 | ------------------------------------------------------------------------ 74 | 75 | -- | Run intcode program using stdio. Non-ASCII outputs are printed as 76 | -- integers. 77 | -- 78 | -- Note that input and output is affected by handle buffering modes. 79 | -- 80 | -- >>> runIO (run (new [104,72,104,101,104,108,104,108,104,111,104,33,104,10,99])) 81 | -- Hello! 82 | -- 83 | -- >>> runIO (run (new [104,-50,104,1000,99])) 84 | -- <<-50>> 85 | -- <<1000>> 86 | runIO :: Effect -> IO () 87 | runIO = hRunIO stdin stdout 88 | 89 | -- | 'runIO' generalized to an arbitrary input and output handle. 90 | hRunIO :: 91 | Handle {- ^ input handle -} -> 92 | Handle {- ^ output handle -} -> 93 | Effect {- ^ effect -} -> 94 | IO () 95 | hRunIO inH outH = go 96 | where 97 | go (Output o e) 98 | | 0 <= o, o < 0x80 = hPutChar outH (chr (fromIntegral o)) >> go e 99 | | otherwise = hPutStrLn outH ("<<" ++ show o ++ ">>") >> go e 100 | go (Input f) = go . f . fromIntegral . ord =<< hGetChar inH 101 | go Halt = return () 102 | go Fault = throwIO IntcodeFault 103 | 104 | ------------------------------------------------------------------------ 105 | -- High-level interface 106 | ------------------------------------------------------------------------ 107 | 108 | -- | Run a given memory image as a list transducer. 109 | -- 110 | -- Use 'effectList' when you want to provide a specific 'Effect'. 111 | -- 112 | -- Throws: 'IntcodeFault' when machine faults or too few inputs are provided. 113 | -- 114 | -- 115 | -- >>> intcodeToList [3,12,6,12,15,1,13,14,13,4,13,99,-1,0,1,9] <$> [[0],[10]] 116 | -- [[0],[1]] 117 | -- 118 | -- >>> intcodeToList [3,3,1105,-1,9,1101,0,0,12,4,12,99,1] <$> [[0],[10]] 119 | -- [[0],[1]] 120 | -- 121 | -- >>> :{ 122 | -- >>> intcodeToList 123 | -- >>> [3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31, 124 | -- >>> 1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104, 125 | -- >>> 999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99] 126 | -- >>> <$> [[7],[8],[9]] 127 | -- >>> :} 128 | -- [[999],[1000],[1001]] 129 | intcodeToList :: 130 | [Int] {- ^ initial memory -} -> 131 | [Int] {- ^ inputs -} -> 132 | [Int] {- ^ outputs -} 133 | intcodeToList = effectList . run . new 134 | 135 | -- | Evaluate a program's effect as a function from a list of 136 | -- inputs to a list of outputs. 137 | -- 138 | -- Throws: 'IntcodeFault' when machine faults or too few inputs are provided. 139 | effectList :: 140 | Effect {- ^ program effect -} -> 141 | [Int] {- ^ inputs -} -> 142 | [Int] {- ^ outputs -} 143 | effectList effect inputs = 144 | case effect of 145 | Fault -> throw IntcodeFault 146 | Halt -> [] 147 | Output o e -> o : effectList e inputs 148 | Input f -> 149 | case inputs of 150 | x:xs -> effectList (f x) xs 151 | [] -> throw IntcodeFault 152 | 153 | ------------------------------------------------------------------------ 154 | -- Big-step semantics 155 | ------------------------------------------------------------------------ 156 | 157 | -- | Possible effects from running a machine 158 | data Effect 159 | = Output !Int Effect -- ^ Output an integer 160 | | Input (Int -> Effect) -- ^ Input an integer 161 | | Halt -- ^ Halt execution 162 | | Fault -- ^ Execution failure 163 | deriving Show 164 | 165 | -- | Big-step semantics of virtual machine. The implementation details 166 | -- of 'Machine' are abstracted away and the program behavior can be 167 | -- observed by interpreting the various 'Effect' constructors. 168 | -- 169 | -- >>> run (new [1102,34915192,34915192,7,4,7,99,0]) 170 | -- Output 1219070632396864 Halt 171 | -- 172 | -- >>> run (new [3,1,99]) 173 | -- Input 174 | run :: Machine -> Effect 175 | run mach = 176 | case step mach of 177 | Step mach' -> run mach' 178 | StepOut out mach' -> Output out (run mach') 179 | StepIn f -> Input (run . f) 180 | StepHalt -> Halt 181 | StepFault -> Fault 182 | 183 | ------------------------------------------------------------------------ 184 | -- Exceptions 185 | ------------------------------------------------------------------------ 186 | 187 | -- | Error when a machine fails to decode an instruction. 188 | data IntcodeFault = IntcodeFault 189 | deriving (Eq, Ord, Show, Read) 190 | 191 | instance Exception IntcodeFault where 192 | displayException _ = "intcode machine fault" 193 | -------------------------------------------------------------------------------- /src/Intcode/Machine.hs: -------------------------------------------------------------------------------- 1 | {-# Language Trustworthy #-} 2 | {-| 3 | Module : Intcode.Machine 4 | Description : Intcode machine representation 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | The module implements the representation of the intcode machine state. 10 | 11 | The 'Machine' type stores the initial memory image in an array and 12 | only stores changes to that initial image. This allows for more efficient 13 | comparisons of machine states for equality when there are few changes to 14 | memory. 15 | 16 | This implementation of the machine supports negative memory addresses. 17 | These are defined not to be used in the Advent of Code problems. 18 | 19 | This implementation stores machine-sized 'Int' values in memory. 20 | 21 | -} 22 | module Intcode.Machine 23 | ( 24 | -- * Machine state 25 | Machine(..), new, 26 | 27 | -- * Register operations 28 | jmp, addRelBase, 29 | 30 | -- * Memory operations 31 | (!), set, memoryList, 32 | ) 33 | where 34 | 35 | import Data.IntMap (IntMap) 36 | import qualified Data.IntMap as IntMap 37 | import qualified Data.Primitive.PrimArray as P 38 | 39 | -- | Machine state is comprised of the program counter, relative base 40 | -- pointer, and memory. 41 | -- 42 | -- * Interact with registers using: 'jmp', 'addRelBase' 43 | -- * Interact with memory using: ('!'), 'set' 44 | -- * Build new machines with: 'new' 45 | -- 46 | -- Updates to memory are stored separately from the initial values 47 | -- which can enable equality comparisons to be relatively efficient. 48 | -- This efficiency comes from being able to compare the inital memory 49 | -- using only pointer equality when two machines are created by the 50 | -- same call to 'new'. 51 | data Machine = Machine 52 | { pc :: !Int -- ^ program counter 53 | , relBase :: !Int -- ^ relative base pointer 54 | , memUpdates :: !(IntMap Int) -- ^ memory updates 55 | , memInitial :: {-# Unpack #-} !(P.PrimArray Int) -- ^ initial memory 56 | } 57 | deriving (Eq, Ord, Show) 58 | 59 | -- | Value stored in initial memory image at given index. 60 | indexImage :: 61 | Machine {- ^ machine -} -> 62 | Int {- ^ position -} -> 63 | Int {- ^ value -} 64 | indexImage m i 65 | | i < P.sizeofPrimArray a, 0 <= i = P.indexPrimArray a i 66 | | otherwise = 0 67 | where 68 | a = memInitial m 69 | {-# INLINE indexImage #-} 70 | 71 | -- | Memory lookup. 72 | (!) :: 73 | Machine {- ^ machine -} -> 74 | Int {- ^ position -} -> 75 | Int {- ^ value -} 76 | m ! i = IntMap.findWithDefault (indexImage m i) i (memUpdates m) 77 | {-# INLINE (!) #-} 78 | 79 | -- | Construct machine from a list of initial values starting 80 | -- at address 0. Program counter and relative base start at 0. 81 | new :: 82 | [Int] {- ^ initial memory -} -> 83 | Machine 84 | new initialValues = Machine 85 | { pc = 0 86 | , relBase = 0 87 | , memUpdates = IntMap.empty 88 | , memInitial = P.primArrayFromList initialValues 89 | } 90 | 91 | -- | Store value at given memory position. 92 | set :: 93 | Int {- ^ position -} -> 94 | Int {- ^ value -} -> 95 | Machine -> Machine 96 | set i v m 97 | | v == o = m { memUpdates = IntMap.delete i (memUpdates m) } 98 | | otherwise = m { memUpdates = IntMap.insert i v (memUpdates m) } 99 | where 100 | o = indexImage m i 101 | 102 | -- | Add offset to relative base pointer. 103 | addRelBase :: 104 | Int {- ^ offset -} -> 105 | Machine -> Machine 106 | addRelBase i mach = mach { relBase = relBase mach + i } 107 | {-# INLINE addRelBase #-} 108 | 109 | -- | Set program counter to a new address. 110 | jmp :: 111 | Int {- ^ program counter -} -> 112 | Machine -> Machine 113 | jmp i mach = mach { pc = i } 114 | {-# INLINE jmp #-} 115 | 116 | -- | Generate a list representation of memory starting from 117 | -- zero. This can get big for sparsely filled memory using 118 | -- large addresses. Returned values start at position 0. 119 | -- 120 | -- >>> memoryList (set 8 10 (new [1,2,3])) 121 | -- [1,2,3,0,0,0,0,0,10] 122 | memoryList :: 123 | Machine -> 124 | [Int] {- ^ memory values -} 125 | memoryList mach 126 | | IntMap.null (memUpdates mach) = P.primArrayToList (memInitial mach) 127 | | otherwise = [mach ! i | i <- [0 .. top]] 128 | where 129 | top = max (P.sizeofPrimArray (memInitial mach) - 1) 130 | (fst (IntMap.findMax (memUpdates mach))) 131 | -------------------------------------------------------------------------------- /src/Intcode/Opcode.hs: -------------------------------------------------------------------------------- 1 | {-# Language DeriveTraversable, Safe #-} 2 | {-| 3 | Module : Intcode.Opcode 4 | Description : Intcode opcodes 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | This module provides a representation of the intcode machine's opcodes. 10 | 11 | Opcodes are parameterized over their parameters. This allows the 12 | implementation to store both parameter modes and resolved parameter 13 | pointers in the same constructors. 14 | 15 | -} 16 | module Intcode.Opcode 17 | ( 18 | -- * Types 19 | Opcode(..), Mode(..), 20 | 21 | -- * Decoder 22 | decode, 23 | ) where 24 | 25 | ------------------------------------------------------------------------ 26 | -- Opcode decoder 27 | ------------------------------------------------------------------------ 28 | 29 | -- | Parameter modes 30 | data Mode 31 | = Abs -- ^ absolute position 32 | | Imm -- ^ immediate 33 | | Rel -- ^ relative position 34 | deriving (Eq, Ord, Read, Show) 35 | 36 | -- | Opcodes parameterized over argument representations. 37 | data Opcode a 38 | = Add !a !a !a -- ^ __addition:__ @c = a + b@ 39 | | Mul !a !a !a -- ^ __multiplication:__ @c = a * b@ 40 | | Inp !a -- ^ __input:__ @a = input()@ 41 | | Out !a -- ^ __output:__ @output(a)@ 42 | | Jnz !a !a -- ^ __jump-if-true:__ @if a then goto b@ 43 | | Jz !a !a -- ^ __jump-if-false:__ @if !a then goto b@ 44 | | Lt !a !a !a -- ^ __less-than:__ @c = a < b@ 45 | | Eq !a !a !a -- ^ __equals:__ @c = a == b@ 46 | | Arb !a -- ^ __adjust-rel-base:__ @rel += a@ 47 | | Hlt -- ^ __halt__ 48 | deriving (Eq, Ord, Read, Show, Functor, Foldable) 49 | 50 | -- | Decode an instruction to determine the opcode and parameter modes. 51 | -- 52 | -- >>> decode 1002 53 | -- Just (Mul Abs Imm Abs) 54 | decode :: Int {- ^ opcode -} -> Maybe (Opcode Mode) 55 | decode n = 56 | case n `rem` 100 of 57 | 1 -> fill (Add 1 2 3) 58 | 2 -> fill (Mul 1 2 3) 59 | 3 -> fill (Inp 1 ) 60 | 4 -> fill (Out 1 ) 61 | 5 -> fill (Jnz 1 2 ) 62 | 6 -> fill (Jz 1 2 ) 63 | 7 -> fill (Lt 1 2 3) 64 | 8 -> fill (Eq 1 2 3) 65 | 9 -> fill (Arb 1 ) 66 | 99 -> fill Hlt 67 | _ -> Nothing 68 | where 69 | fill = traverse (parameter n) 70 | {-# INLINABLE decode #-} 71 | 72 | -- | Compute the parameter mode for an argument at a given position. 73 | parameter :: 74 | Int {- ^ opcode -} -> 75 | Int {- ^ position -} -> 76 | Maybe Mode 77 | parameter n i = 78 | case digit (i+1) n of 79 | 0 -> Just Abs 80 | 1 -> Just Imm 81 | 2 -> Just Rel 82 | _ -> Nothing 83 | 84 | -- | Arguments visited from left to right. 85 | instance Traversable Opcode where 86 | {-# INLINE traverse #-} 87 | traverse f o = 88 | case o of 89 | Add x y z -> Add <$> f x <*> f y <*> f z 90 | Mul x y z -> Mul <$> f x <*> f y <*> f z 91 | Inp x -> Inp <$> f x 92 | Out x -> Out <$> f x 93 | Jnz x y -> Jnz <$> f x <*> f y 94 | Jz x y -> Jz <$> f x <*> f y 95 | Lt x y z -> Lt <$> f x <*> f y <*> f z 96 | Eq x y z -> Eq <$> f x <*> f y <*> f z 97 | Arb x -> Arb <$> f x 98 | Hlt -> pure Hlt 99 | 100 | -- | Extract the ith digit from a number. 101 | -- 102 | -- >>> digit 0 2468 103 | -- 8 104 | -- >>> digit 3 2468 105 | -- 2 106 | -- >>> digit 4 2468 107 | -- 0 108 | digit :: Int {- ^ position -} -> Int {- ^ number -} -> Int {- ^ digit -} 109 | digit i x = x `quot` (10^i) `rem` 10 110 | -------------------------------------------------------------------------------- /src/Intcode/Parse.hs: -------------------------------------------------------------------------------- 1 | {-# Language Safe #-} 2 | {-| 3 | Module : Intcode.Parse 4 | Description : Intcode source file parser 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | This module implements a parser for the simple comma, separated format 10 | used in the Advent of Code input files. 11 | 12 | -} 13 | module Intcode.Parse (parseInts) where 14 | 15 | -- | Parse a list of comma separated integers. 16 | -- 17 | -- >>> parseInts "1, - 2, 3,-4" 18 | -- Just [1,-2,3,-4] 19 | -- 20 | -- >>> parseInts " " 21 | -- Just [] 22 | -- 23 | -- >>> parseInts "1,2,3,x" 24 | -- Nothing 25 | parseInts :: 26 | String {- ^ parser input -} -> 27 | Maybe [Int] {- ^ parsed integers -} 28 | parseInts str 29 | | [(i,str1)] <- reads str = parseInts' [i] str1 30 | | [("","")] <- lex str = Just [] 31 | | otherwise = Nothing 32 | 33 | -- | Helper function for 'parseInts' 34 | parseInts' :: 35 | [Int] {- ^ reversed accumulator -} -> 36 | String {- ^ parser input -} -> 37 | Maybe [Int] {- ^ parsed integers -} 38 | parseInts' xs str = 39 | case lex str of 40 | [(",",str1)] | [(x,str2)] <- reads str1 -> parseInts' (x:xs) str2 41 | [("","")] -> Just (reverse xs) 42 | _ -> Nothing 43 | -------------------------------------------------------------------------------- /src/Intcode/Step.hs: -------------------------------------------------------------------------------- 1 | {-# Language Safe #-} 2 | {-| 3 | Module : Intcode.Step 4 | Description : Intcode small-step semantics 5 | Copyright : (c) Eric Mertens, 2019,2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | This module advances a 'Machine' by interpreting the opcode at the 10 | current program counter. 11 | 12 | -} 13 | module Intcode.Step (Step(..), step) where 14 | 15 | import Data.Traversable (mapAccumL) 16 | import Text.Show.Functions () 17 | 18 | import Intcode.Opcode (Mode(..), Opcode(..), decode) 19 | import Intcode.Machine (Machine, (!), addRelBase, jmp, pc, relBase, set) 20 | 21 | -- | Result of small-step semantics. 22 | data Step 23 | = Step !Machine -- ^ update machine without output 24 | | StepOut !Int !Machine -- ^ update machine with output 25 | | StepIn (Int -> Machine) -- ^ machine blocked waiting for input 26 | | StepHalt -- ^ halt 27 | | StepFault -- ^ bad instruction 28 | deriving Show 29 | 30 | -- | Small-step semantics of virtual machine. 31 | step :: Machine -> Step 32 | step mach = 33 | case populateParams <$> decode (mach ! pc mach) of 34 | Nothing -> StepFault 35 | Just (pc', opcode) -> opcodeImpl opcode $! jmp pc' mach 36 | 37 | where 38 | populateParams :: Opcode Mode -> (Int, Opcode Int) 39 | populateParams = mapWithIndex toPtr (pc mach + 1) 40 | 41 | toPtr :: Int -> Mode -> Int 42 | toPtr i Imm = i 43 | toPtr i Abs = mach ! i 44 | toPtr i Rel = mach ! i + relBase mach 45 | 46 | -- | Apply a decoded opcode to the machine state. 47 | opcodeImpl :: 48 | Opcode Int {- ^ opcode with pointers -} -> 49 | Machine {- ^ machine with PC updated -} -> 50 | Step 51 | opcodeImpl o m = 52 | case o of 53 | Add a b c -> Step (set c (at a + at b) m) 54 | Mul a b c -> Step (set c (at a * at b) m) 55 | Inp a -> StepIn (\i -> set a i m) 56 | Out a -> StepOut (at a) m 57 | Jnz a b -> Step (if at a /= 0 then jmp (at b) m else m) 58 | Jz a b -> Step (if at a == 0 then jmp (at b) m else m) 59 | Lt a b c -> Step (set c (if at a < at b then 1 else 0) m) 60 | Eq a b c -> Step (set c (if at a == at b then 1 else 0) m) 61 | Arb a -> Step (addRelBase (at a) m) 62 | Hlt -> StepHalt 63 | where 64 | at i = m ! i 65 | 66 | mapWithIndex :: (Int -> a -> b) -> Int -> Opcode a -> (Int, Opcode b) 67 | mapWithIndex f = mapAccumL (\i a -> (i+1, f i a)) 68 | {-# INLINE mapWithIndex #-} 69 | --------------------------------------------------------------------------------