Advent of Code: Day 8

(defun parse-instruction (input)
  (with-input-from-string (s input)
    (list (read s)
          (read s))))

(defun parse-program (input)
  (apply #'vector (utils:map-line #'parse-instruction input)))

(defstruct process
  program
  (pc 0)
  (acc 0)
  call-graph
  (status :running))

(defun fork (process &optional replacement-op &aux fork)
  (setf fork (copy-structure process))
  (setf (process-program fork) (copy-seq (process-program process)))
  (when replacement-op
    (setf (program-op fork) replacement-op))
  fork)

(defun acc (process n) (incf (process-acc process) n))
(defun jmp (process n) (incf (process-pc process) n))
(defun nop (process n) (declare (ignore process n)))

(defun step-process (process)
  (with-slots (program pc acc call-graph status) process
    (if (>= pc (length program))
        (setf status :halt)
        (if (member pc call-graph)
            (setf status :loop)
            (destructuring-bind (op arg) (aref program pc)
              (push pc call-graph)
              (funcall op process arg)
              (unless (eq op 'jmp) (incf pc))))))
  process)

(defun program-op (process)
  (first (aref (process-program process) (process-pc process))))

(defun (setf program-op) (val process)
  (with-slots (program pc) process
    (setf (aref program pc)
          (list val (second (aref program pc))))))

(defun run (process)
  "Runes a PROCESS until it stops (its status is :HALT or :LOOP). Returns the
process."
  (loop :while (eq :running (process-status process))
        :do (step-process process))
  process)

(defun run* (process)
  "RUN* is like RUN but it tries to fix a potential infinite loop by changing
one NOP to JMP or one JMP to NOP. Returns the first process to :HALT or NIL."
  (catch 'found
    (labels ((rec (process &optional rec-p)
               (loop (case (process-status process)
                       (:loop (return))
                       (:halt (throw 'found process)))
                     (unless rec-p
                       (case (program-op process)
                         (nop (rec (fork process 'jmp) t))
                         (jmp (rec (fork process 'nop) t))))
                     (step-process process))))
      (rec process))))

(defun part-1 ()
  (run (make-process :program (parse-program *input*))))

(defun part-2 ()
  (run* (make-process :program (parse-program *input*))))