Skip to content

Commit 843094e

Browse files
kdungskdungs
committed
Solve day 12 of 2016.
1 parent 5ac4a45 commit 843094e

File tree

3 files changed

+121
-61
lines changed

3 files changed

+121
-61
lines changed

‎2016/12.hs

+112
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
import Text.ParserCombinators.Parsec
2+
import Text.ParserCombinators.Parsec.Number (int)
3+
import qualified Data.List as List
4+
import qualified Data.Map.Strict as Map
5+
6+
newtype Register = Register Char deriving Show
7+
newtype Value = Value Int deriving Show
8+
9+
addV :: Value -> Int -> Value
10+
addV (Value v) x = Value (v + x)
11+
12+
data ValueOrRegister = V Value | R Register deriving Show
13+
14+
data Instruction = Cpy ValueOrRegister Register
15+
| Inc Register
16+
| Dec Register
17+
| Jnz ValueOrRegister Value
18+
deriving Show
19+
20+
data Registers = Registers Value Value Value Value deriving Show
21+
22+
defaultR :: Registers
23+
defaultR = Registers (Value 0) (Value 0) (Value 0) (Value 0)
24+
25+
getR :: Registers -> Register -> Value
26+
getR (Registers a _ _ _) (Register 'a') = a
27+
getR (Registers _ b _ _) (Register 'b') = b
28+
getR (Registers _ _ c _) (Register 'c') = c
29+
getR (Registers _ _ _ d) (Register 'd') = d
30+
31+
setR :: Registers -> Register -> Value -> Registers
32+
setR (Registers _ b c d) (Register 'a') a = Registers a b c d
33+
setR (Registers a _ c d) (Register 'b') b = Registers a b c d
34+
setR (Registers a b _ d) (Register 'c') c = Registers a b c d
35+
setR (Registers a b c _) (Register 'd') d = Registers a b c d
36+
37+
incR :: Registers -> Register -> Registers
38+
incR rs r = setR rs r (addV (getR rs r) 1)
39+
40+
decR :: Registers -> Register -> Registers
41+
decR rs r = setR rs r (addV (getR rs r) (-1))
42+
43+
getValueOrRegister :: Registers -> ValueOrRegister -> Value
44+
getValueOrRegister _ (V val) = val
45+
getValueOrRegister regs (R reg) = getR regs reg
46+
47+
data Context = Context { program :: [Instruction]
48+
, registers :: Registers
49+
, iptr :: Int
50+
} deriving Show
51+
52+
defaultContext :: [Instruction] -> Context
53+
defaultContext is = Context is defaultR 0
54+
55+
execute :: Context -> Context
56+
execute c@(Context is _ iptr) = if iptr < (List.length is) then execute (execute_ c (is !! iptr)) else c
57+
58+
execute_ :: Context -> Instruction -> Context
59+
execute_ (Context is regs iptr) (Cpy vor reg) = Context is (setR regs reg (getValueOrRegister regs vor)) (iptr + 1)
60+
execute_ (Context is regs iptr) (Inc reg) = Context is (incR regs reg) (iptr + 1)
61+
execute_ (Context is regs iptr) (Dec reg) = Context is (decR regs reg) (iptr + 1)
62+
execute_ (Context is regs iptr) (Jnz vor (Value offset)) = Context is regs (case getValueOrRegister regs vor of
63+
Value 0 -> iptr + 1
64+
_ -> iptr + offset)
65+
66+
67+
-- Parser
68+
register :: Parser Register
69+
register = Register <$> oneOf "abcd"
70+
71+
value :: Parser Value
72+
value = Value <$> int
73+
74+
valueOrRegister :: Parser ValueOrRegister
75+
valueOrRegister = V <$> value <|> R <$> register
76+
77+
cpy :: Parser Instruction
78+
cpy = do
79+
string "cpy "
80+
vor <- valueOrRegister
81+
char ' '
82+
reg <- register
83+
pure (Cpy vor reg)
84+
85+
inc :: Parser Instruction
86+
inc = Inc <$> (string "inc " >> register)
87+
88+
dec :: Parser Instruction
89+
dec = Dec <$> (string "dec " >> register)
90+
91+
jnz :: Parser Instruction
92+
jnz = do
93+
string "jnz "
94+
vor <- valueOrRegister
95+
char ' '
96+
val <- value
97+
pure (Jnz vor val)
98+
99+
instruction :: Parser Instruction
100+
instruction = choice [cpy, inc, dec, jnz]
101+
102+
instructions :: Parser [Instruction]
103+
instructions = sepEndBy instruction newline
104+
105+
-- Main
106+
main :: IO ()
107+
main = do
108+
contents <- getContents
109+
let is = parse instructions "" contents
110+
print $ execute . defaultContext<$> is
111+
let regs = setR defaultR (Register 'c') (Value 1)
112+
print $ execute . (\is -> Context is regs 0) <$> is

‎2016/adventofcode2016.cabal

+8
Original file line numberDiff line numberDiff line change
@@ -72,3 +72,11 @@ executable 09
7272
build-depends: base,
7373
parsec
7474
default-language: Haskell2010
75+
76+
executable 12
77+
main-is: 12.hs
78+
build-depends: base,
79+
containers,
80+
parsec,
81+
parsec-numbers
82+
default-language: Haskell2010

‎2016/stack.yaml

+1-61
Original file line numberDiff line numberDiff line change
@@ -1,66 +1,6 @@
1-
# This file was automatically generated by 'stack init'
2-
#
3-
# Some commonly used options have been documented as comments in this file.
4-
# For advanced use and comprehensive documentation of the format, please see:
5-
# http://docs.haskellstack.org/en/stable/yaml_configuration/
6-
7-
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8-
# A snapshot resolver dictates the compiler version and the set of packages
9-
# to be used for project dependencies. For example:
10-
#
11-
# resolver: lts-3.5
12-
# resolver: nightly-2015-09-21
13-
# resolver: ghc-7.10.2
14-
# resolver: ghcjs-0.1.0_ghc-7.10.2
15-
# resolver:
16-
# name: custom-snapshot
17-
# location: "./custom-snapshot.yaml"
18-
resolver: lts-7.12
19-
20-
# User packages to be built.
21-
# Various formats can be used as shown in the example below.
22-
#
23-
# packages:
24-
# - some-directory
25-
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
26-
# - location:
27-
# git: https://github.com/commercialhaskell/stack.git
28-
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
29-
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
30-
# extra-dep: true
31-
# subdirs:
32-
# - auto-update
33-
# - wai
34-
#
35-
# A package marked 'extra-dep: true' will only be built if demanded by a
36-
# non-dependency (i.e. a user package), and its test suites and benchmarks
37-
# will not be run. This is useful for tweaking upstream packages.
1+
resolver: lts-14.16
382
packages:
393
- '.'
40-
# Dependency packages to be pulled from upstream that are not in the resolver
41-
# (e.g., acme-missiles-0.3)
424
extra-deps: []
43-
44-
# Override default flag values for local packages and extra-deps
455
flags: {}
46-
47-
# Extra package databases containing global packages
486
extra-package-dbs: []
49-
50-
# Control whether we use the GHC we find on the path
51-
# system-ghc: true
52-
#
53-
# Require a specific version of stack, using version ranges
54-
# require-stack-version: -any # Default
55-
# require-stack-version: ">=1.2"
56-
#
57-
# Override the architecture used by stack, especially useful on Windows
58-
# arch: i386
59-
# arch: x86_64
60-
#
61-
# Extra directories used by stack for building
62-
# extra-include-dirs: [/path/to/dir]
63-
# extra-lib-dirs: [/path/to/dir]
64-
#
65-
# Allow a newer minor version of GHC than the snapshot specifies
66-
# compiler-check: newer-minor

0 commit comments

Comments
 (0)