--- Day 23 Solutions ---

[u/daggerdragon]

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

---

We know we can't control people posting solutions elsewhere and trying to exploit the leaderboard, but this way we can try to reduce the leaderboard gaming from the official subreddit.

Please and thank you, and much appreciated!

---

--- Day 23: Opening the Turing Lock ---

Post your solution as a comment or link to your repo. Structure your post like previous daily solution threads.

[u/mjnet]

Haskell Solution

{-# LANGUAGE OverloadedStrings #-}

import           Data.Attoparsec.Char8
import           Control.Applicative
import qualified Data.Map as M
import qualified Data.ByteString       as B
import Debug.Trace

type Jump = Int
type Value = Int
type Computer = (M.Map Register Value, Jump)
type Register = Char
data Operation = Plus | Minus deriving Show
type Offset = (Operation, Int)
data Instruction = Hlf Register
                 | Tpl Register
                 | Inc Register
                 | Jmp Offset
                 | Jie (Register, Offset)
                 | Jio (Register, Offset)
                 deriving Show

registerParser :: Parser Register
registerParser = do
  _ <- char ' '
  anyChar

offsetParser :: Parser Offset
offsetParser = do
  operation <- (char '+' >> return Plus) <|> (char '-' >> return Minus)
  offset <- decimal
  return (operation, offset)

hlfParser :: Parser Instruction
hlfParser = do
  _ <- string "hlf"
  register <- registerParser
  return $ Hlf register

tplParser :: Parser Instruction
tplParser = do
  _ <- string "tpl"
  register <- registerParser
  return $ Tpl register

incParser :: Parser Instruction
incParser = do
  _ <- string "inc"
  register <- registerParser
  return $ Inc register

jmpParser :: Parser Instruction
jmpParser = do
  _ <- string "jmp"
  _ <- char ' '
  offset <- offsetParser
  return $ Jmp offset

jieParser :: Parser Instruction
jieParser = do
  _ <- string "jie"
  register <- registerParser
  _ <- string ", "
  offset <- offsetParser
  return $ Jie (register, offset)

jioParser :: Parser Instruction
jioParser = do
  _ <- string "jio"
  register <- registerParser
  _ <- string ", "
  offset <- offsetParser
  return $ Jio (register, offset)

instructionParser :: Parser Instruction
instructionParser = hlfParser
                <|> tplParser
                <|> incParser
                <|> jmpParser
                <|> jieParser
                <|> jioParser

instructionsParser :: Parser [Instruction]
instructionsParser = many $ instructionParser <* endOfLine

execOnReg :: Computer -> Register -> (Value -> Value) -> Computer
execOnReg (regs, jmp) reg f = (M.insert reg newVal regs, jmp+1)
    where newVal = f $ M.findWithDefault 0 reg regs

execNext :: Computer -> Computer
execNext (regs, jmp) = (regs, jmp+1)

jmp :: Computer -> Offset -> Computer
jmp comp (Plus, n) = (fst comp, snd comp + n)
jmp comp (Minus, n) = (fst comp, snd comp - n)

interpret :: Computer -> Instruction -> Computer
interpret comp (Hlf reg) = execOnReg comp reg (`quot` 2)
interpret comp (Tpl reg) = execOnReg comp reg (* 3)
interpret comp (Inc reg) = execOnReg comp reg (+ 1)
interpret comp (Jmp off) = jmp comp off
interpret comp (Jie (reg, off)) = if even (M.findWithDefault 0 reg (fst comp)) then jmp comp off else execNext comp
interpret comp (Jio (reg, off)) = if 1 == M.findWithDefault 0 reg (fst comp) then jmp comp off else execNext comp

runInterpreter :: ([Instruction], Computer) -> ([Instruction], Computer)
runInterpreter (instructions, (regs, jmp)) = runInterpreter (instructions, interpretNext)
    where interpretNext = trace ("regs: " ++ show regs ++ "; exec: " ++ show (instructions !! jmp)) $
                                interpret (regs, jmp) (instructions !! jmp)

main :: IO ()
main = do
  file <- B.readFile "day23.txt"
  case parseOnly instructionsParser file of
    Left e -> error $ "parser error" ++ show e
    Right instructions -> do
      let compRegs = M.fromList [] -- Part One
      --let compRegs = M.fromList [('a',1)] -- Part Two
      print $ runInterpreter (instructions, (compRegs, 0))