aoc2020 day8

aoc2020-day8.lisp

;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2020                                            |
;;;; +----------------------------------------------------------------+

(defpackage #:snippets/aoc2020/day8
  (:use #:cl)
  (:import-from
   #:split-sequence
   #:split-sequence)
  (:import-from
   #:alexandria
   #:make-keyword
   #:destructuring-ecase)
  (:export
   #:day8))

(in-package #:snippets/aoc2020/day8)

(defun parse (input)
  (map 'vector #'parse-instruction input))

(defun parse-instruction (string)
  (destructuring-bind (operation argument)
      (split-sequence #\Space string)
    (list (make-keyword (string-upcase operation))
          (parse-integer argument))))

(defun run (program)
  (let ((pc 0)
        (accumulator 0)
        (executed (make-array (length program)
                              :element-type 'bit
                              :initial-element 0)))
    (loop
     (cond ((>= pc (length program))
            (return-from run (values accumulator :finish)))
           ((= 1 (aref executed pc))
            (return-from run (values accumulator :loop))))
     (setf (aref executed pc) 1)
     (destructuring-ecase (aref program pc)
       ((:acc increment)
        (incf accumulator increment)
        (incf pc))
       ((:nop dummy)
        (declare (ignore dummy))
        (incf pc))
       ((:jmp offset)
        (incf pc offset))))))

(defun next-patch-position (program &optional (start 0))
  (position-if (lambda (instruction)
                 (member (car instruction) '(:nop :jmp)))
               program
               :start start))

(defun patch (program position)
  (symbol-macrolet ((instruction (aref program position)))
    (setf instruction
          (cons (ecase (car instruction)
                  (:nop :jmp)
                  (:jmp :nop))
                (cdr instruction)))))

(defun fix (program)
  (do ((position (next-patch-position program)
                 (next-patch-position program (1+ position))))
      ((null position)
       (error "Can't fix program ~S." program))
    (patch program position)
    (multiple-value-bind (accumulator status)
        (run program)
      (ecase status
        (:finish
         (return-from fix accumulator))
        (:loop
         (patch program position))))))

(defun day8 (input)
  (let ((program (parse input)))
    (list (run program)
          (fix program))))