Guest User

Advent of Code: Day 8

a guest
Dec 9th, 2020
78
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 2.39 KB | None | 0 0
  1. (defun parse-instruction (input)
  2.   (with-input-from-string (s input)
  3.     (list (read s)
  4.           (read s))))
  5.  
  6. (defun parse-program (input)
  7.   (apply #'vector (utils:map-line #'parse-instruction input)))
  8.  
  9. (defstruct process
  10.   program
  11.   (pc 0)
  12.   (acc 0)
  13.   call-graph
  14.   (status :running))
  15.  
  16. (defun fork (process &optional replacement-op &aux fork)
  17.   (setf fork (copy-structure process))
  18.   (setf (process-program fork) (copy-seq (process-program process)))
  19.   (when replacement-op
  20.     (setf (program-op fork) replacement-op))
  21.   fork)
  22.  
  23. (defun acc (process n) (incf (process-acc process) n))
  24. (defun jmp (process n) (incf (process-pc process) n))
  25. (defun nop (process n) (declare (ignore process n)))
  26.  
  27. (defun step-process (process)
  28.   (with-slots (program pc acc call-graph status) process
  29.     (if (>= pc (length program))
  30.         (setf status :halt)
  31.         (if (member pc call-graph)
  32.             (setf status :loop)
  33.             (destructuring-bind (op arg) (aref program pc)
  34.               (push pc call-graph)
  35.               (funcall op process arg)
  36.               (unless (eq op 'jmp) (incf pc))))))
  37.   process)
  38.  
  39. (defun program-op (process)
  40.   (first (aref (process-program process) (process-pc process))))
  41.  
  42. (defun (setf program-op) (val process)
  43.   (with-slots (program pc) process
  44.     (setf (aref program pc)
  45.           (list val (second (aref program pc))))))
  46.  
  47. (defun run (process)
  48.   "Runes a PROCESS until it stops (its status is :HALT or :LOOP). Returns the
  49. process."
  50.   (loop :while (eq :running (process-status process))
  51.         :do (step-process process))
  52.   process)
  53.  
  54. (defun run* (process)
  55.   "RUN* is like RUN but it tries to fix a potential infinite loop by changing
  56. one NOP to JMP or one JMP to NOP. Returns the first process to :HALT or NIL."
  57.   (catch 'found
  58.     (labels ((rec (process &optional rec-p)
  59.                (loop (case (process-status process)
  60.                        (:loop (return))
  61.                        (:halt (throw 'found process)))
  62.                      (unless rec-p
  63.                        (case (program-op process)
  64.                          (nop (rec (fork process 'jmp) t))
  65.                          (jmp (rec (fork process 'nop) t))))
  66.                      (step-process process))))
  67.       (rec process))))
  68.  
  69. (defun part-1 ()
  70.   (run (make-process :program (parse-program *input*))))
  71.  
  72. (defun part-2 ()
  73.   (run* (make-process :program (parse-program *input*))))
Add Comment
Please, Sign In to add comment