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)))

(defparameter *input* (parse-program (utils:read-file "8.dat")))

(defun run (program &optional fix-p)
    "RUNs a PROCESS until it stops. Returns the accumulator and the call history
or NIL if the program doesn't stop. When FIX-P is true, RUN tries to fix a
potential infinite loop by changing one NOP to JMP or one JMP to NOP. Stops when
the first branched halts. "
  (catch 'found
    (labels ((aux (fixed-p &optional (acc 0) (pc 0) calls)
               (let (instruction op arg)
                 (loop
                   (when (>= pc (length program))
                     (throw 'found (values acc (reverse calls) :halt)))
                   (when (and (member pc calls))
                     (if fix-p
                         (return)
                         (throw 'found (values acc (reverse calls) :loop))))
                   (setf instruction (aref program pc))
                   (setf op (car instruction))
                   (setf arg (cadr instruction))
                   (push pc calls)
                   (case op
                     (nop
                      (unless fixed-p
                        (aux t acc (+ pc arg) calls))
                      (incf pc))
                     (acc (incf acc arg) (incf pc))
                     (jmp
                      (unless fixed-p
                        (aux t acc (1+ pc) calls))
                      (incf pc arg)))))))
      (aux (not fix-p)))))

(defun part-1 ()
  (run (parse-program *input*)))

(defun part-2 ()
  (run (parse-program *input*) t))