From 60c5b73dba31760faf3bb138f4c58e38518db685 Mon Sep 17 00:00:00 2001 From: Jonathan Chan Date: Fri, 20 Dec 2019 14:52:20 -0800 Subject: [PATCH] Added Haskell implementation of an IntCode interpreter. --- .gitignore | 2 + haskell/LICENSE | 30 ++++++++++++ haskell/Setup.hs | 2 + haskell/app/Main.hs | 6 +++ haskell/package.yaml | 35 ++++++++++++++ haskell/src/Day02.hs | 9 ++++ haskell/src/IntCode.hs | 100 ++++++++++++++++++++++++++++++++++++++++ haskell/stack.yaml | 66 ++++++++++++++++++++++++++ haskell/stack.yaml.lock | 12 +++++ 9 files changed, 262 insertions(+) create mode 100644 haskell/LICENSE create mode 100644 haskell/Setup.hs create mode 100644 haskell/app/Main.hs create mode 100644 haskell/package.yaml create mode 100644 haskell/src/Day02.hs create mode 100644 haskell/src/IntCode.hs create mode 100644 haskell/stack.yaml create mode 100644 haskell/stack.yaml.lock diff --git a/.gitignore b/.gitignore index 35a4f73..39f24e6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,4 @@ **/*.bak compiled/ +**/.stack-work/ +**/*.cabal diff --git a/haskell/LICENSE b/haskell/LICENSE new file mode 100644 index 0000000..7352fbb --- /dev/null +++ b/haskell/LICENSE @@ -0,0 +1,30 @@ +Copyright Jonathan Chan (c) 2019 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jonathan Chan nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/haskell/Setup.hs b/haskell/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/haskell/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs new file mode 100644 index 0000000..6d3d485 --- /dev/null +++ b/haskell/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Day02 (day02) + +main :: IO () +main = day02 diff --git a/haskell/package.yaml b/haskell/package.yaml new file mode 100644 index 0000000..9ede7df --- /dev/null +++ b/haskell/package.yaml @@ -0,0 +1,35 @@ +name: aoc2019 +version: 0.1.0.0 +github: "ionathanch/adventofcode-2019" +license: BSD3 +author: "Jonathan Chan" +maintainer: "afnl686@gmail.com" +copyright: "2019 Jonathan Chan" + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- containers +- mtl + +library: + source-dirs: src + +executables: + aoc2019-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - aoc2019 \ No newline at end of file diff --git a/haskell/src/Day02.hs b/haskell/src/Day02.hs new file mode 100644 index 0000000..1799de7 --- /dev/null +++ b/haskell/src/Day02.hs @@ -0,0 +1,9 @@ +module Day02 where + +import IntCode (IntCodeState(..), initState, getProgram, execUntilHalt) + +input = [1,12,2,3,1,1,2,3,1,3,4,3,1,5,0,3,2,1,9,19,1,10,19,23,2,9,23,27,1,6,27,31,2,31,9,35,1,5,35,39,1,10,39,43,1,10,43,47,2,13,47,51,1,10,51,55,2,55,10,59,1,9,59,63,2,6,63,67,1,5,67,71,1,71,5,75,1,5,75,79,2,79,13,83,1,83,5,87,2,6,87,91,1,5,91,95,1,95,9,99,1,99,6,103,1,103,13,107,1,107,5,111,2,111,13,115,1,115,6,119,1,6,119,123,2,123,13,127,1,10,127,131,1,131,2,135,1,135,5,0,99,2,14,0,0] + +day02 = do + putStr "Part 1: " + print . head . getProgram . execUntilHalt $ initState input \ No newline at end of file diff --git a/haskell/src/IntCode.hs b/haskell/src/IntCode.hs new file mode 100644 index 0000000..181ff03 --- /dev/null +++ b/haskell/src/IntCode.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE MonadFailDesugaring #-} + +module IntCode + ( IntCodeState(..) + , initState + , getProgram + , execUntilHalt + ) where + +import Data.List (sort) +import Data.IntMap (IntMap, Key, findWithDefault, insert, fromList, toList) +import Control.Monad.State (State, get, put, modify, runState) + +type Program = IntMap Int +type Pointer = Int +type Base = Int + +data IntCodeState = IntCodeState { + program :: Program, + pointer :: Pointer, + base :: Base, + inputs :: [Int] +} + +data Result = Output Int | Continue | Halted + +(%) = mod +(//) = div + +(!) :: Program -> Key -> Int +infixl 5 ! -- just below arithmetic +(!) = flip $ findWithDefault 0 + +noop :: State IntCodeState () +noop = return () + +updateProgram :: Key -> Int -> State IntCodeState () +updateProgram key val = + modify $ \st -> st { program = insert key val (program st) } + +updatePointer :: Pointer -> State IntCodeState () +updatePointer ptr = + modify $ \st -> st { pointer = ptr } + +updateBase :: Base -> State IntCodeState () +updateBase delta = + modify $ \st -> st { base = base st + delta } + +readInput :: State IntCodeState Int +readInput = do + st <- get + put st { inputs = tail $ inputs st } + return . head $ inputs st + +exec :: State IntCodeState Result +exec = do + IntCodeState program pointer base _ <- get + let instr = program ! pointer + opcode = instr % 100 + ptrInc + | opcode `elem` [1, 2, 7, 8] = 4 + | opcode `elem` [5, 6] = 3 + | opcode `elem` [3, 4, 9] = 2 + | opcode == 99 = 1 + nextPtr = pointer + ptrInc + getLoc i mode = case mode of + 0 -> program ! pointer + i + 1 -> pointer + i + 2 -> base + (program ! pointer + i) + loc1 = getLoc 1 $ instr // 100 % 10 + loc2 = getLoc 2 $ instr // 1000 % 10 + loc3 = getLoc 3 $ instr // 10000 % 10 + val1 = program ! loc1 + val2 = program ! loc2 + val3 = program ! loc3 + updatePointer nextPtr + case opcode of + 1 -> updateProgram loc3 (val1 + val2) >> return Continue + 2 -> updateProgram loc3 (val1 * val2) >> return Continue + 3 -> readInput >>= updateProgram loc1 >> return Continue + 4 -> return $ Output val1 + 5 -> (if (val1 /= 0) then updatePointer val2 else noop) >> return Continue + 6 -> (if (val1 == 0) then updatePointer val2 else noop) >> return Continue + 7 -> updateProgram loc3 (if (val1 < val2) then 1 else 0) >> return Continue + 8 -> updateProgram loc3 (if (val1 == val2) then 1 else 0) >> return Continue + 9 -> updateBase val1 >> return Continue + 99 -> return Halted + +initState :: [Int] -> IntCodeState +initState list = IntCodeState (fromList $ zip [0..] list) 0 0 [] + +getProgram :: IntCodeState -> [Int] +getProgram = map snd . sort . toList . program + +execUntilHalt :: IntCodeState -> IntCodeState +execUntilHalt st = + let (result, st') = runState exec st + in case result of + Halted -> st' + _ -> execUntilHalt st' \ No newline at end of file diff --git a/haskell/stack.yaml b/haskell/stack.yaml new file mode 100644 index 0000000..29f8539 --- /dev/null +++ b/haskell/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-14.17 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.1" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/haskell/stack.yaml.lock b/haskell/stack.yaml.lock new file mode 100644 index 0000000..fc538c1 --- /dev/null +++ b/haskell/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 524799 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/17.yaml + sha256: 1d72b33c0fc048e23f4f18fd76a6ad79dd1d8a3c054644098a71a09855e40c7c + original: lts-14.17