Day 5 passing
3 files changed, 129 insertions(+), 25 deletions(-) A day5-input.txt A day5-input2.txt M intcode.lisp
A day5-input.txt => day5-input.txt +1 -0
@@ 0,0 1,1 @@ 3,225,1,225,6,6,1100,1,238,225,104,0,1002,43,69,224,101,-483,224,224,4,224,1002,223,8,223,1001,224,5,224,1,224,223,223,1101,67,60,225,1102,5,59,225,1101,7,16,225,1102,49,72,225,101,93,39,224,101,-98,224,224,4,224,102,8,223,223,1001,224,6,224,1,224,223,223,1102,35,82,225,2,166,36,224,101,-4260,224,224,4,224,102,8,223,223,101,5,224,224,1,223,224,223,102,66,48,224,1001,224,-4752,224,4,224,102,8,223,223,1001,224,2,224,1,223,224,223,1001,73,20,224,1001,224,-55,224,4,224,102,8,223,223,101,7,224,224,1,223,224,223,1102,18,41,224,1001,224,-738,224,4,224,102,8,223,223,101,6,224,224,1,224,223,223,1101,68,71,225,1102,5,66,225,1101,27,5,225,1101,54,63,224,1001,224,-117,224,4,224,102,8,223,223,1001,224,2,224,1,223,224,223,1,170,174,224,101,-71,224,224,4,224,1002,223,8,223,1001,224,4,224,1,223,224,223,4,223,99,0,0,0,677,0,0,0,0,0,0,0,0,0,0,0,1105,0,99999,1105,227,247,1105,1,99999,1005,227,99999,1005,0,256,1105,1,99999,1106,227,99999,1106,0,265,1105,1,99999,1006,0,99999,1006,227,274,1105,1,99999,1105,1,280,1105,1,99999,1,225,225,225,1101,294,0,0,105,1,0,1105,1,99999,1106,0,300,1105,1,99999,1,225,225,225,1101,314,0,0,106,0,0,1105,1,99999,1007,226,226,224,1002,223,2,223,1006,224,329,1001,223,1,223,1007,226,677,224,102,2,223,223,1006,224,344,1001,223,1,223,108,677,677,224,102,2,223,223,1005,224,359,1001,223,1,223,1007,677,677,224,1002,223,2,223,1006,224,374,101,1,223,223,8,677,226,224,1002,223,2,223,1006,224,389,101,1,223,223,7,226,226,224,1002,223,2,223,1005,224,404,101,1,223,223,7,677,226,224,102,2,223,223,1005,224,419,1001,223,1,223,8,226,677,224,1002,223,2,223,1005,224,434,101,1,223,223,1008,226,677,224,102,2,223,223,1006,224,449,1001,223,1,223,7,226,677,224,1002,223,2,223,1006,224,464,1001,223,1,223,108,677,226,224,102,2,223,223,1005,224,479,101,1,223,223,108,226,226,224,1002,223,2,223,1006,224,494,101,1,223,223,8,226,226,224,1002,223,2,223,1005,224,509,1001,223,1,223,1107,677,226,224,102,2,223,223,1005,224,524,1001,223,1,223,1107,226,226,224,102,2,223,223,1005,224,539,1001,223,1,223,1108,677,677,224,1002,223,2,223,1006,224,554,101,1,223,223,107,226,677,224,102,2,223,223,1005,224,569,1001,223,1,223,1108,226,677,224,1002,223,2,223,1005,224,584,1001,223,1,223,1107,226,677,224,1002,223,2,223,1005,224,599,1001,223,1,223,1008,226,226,224,1002,223,2,223,1005,224,614,101,1,223,223,107,226,226,224,102,2,223,223,1006,224,629,1001,223,1,223,1008,677,677,224,1002,223,2,223,1006,224,644,101,1,223,223,107,677,677,224,1002,223,2,223,1005,224,659,101,1,223,223,1108,677,226,224,1002,223,2,223,1006,224,674,1001,223,1,223,4,223,99,226
A day5-input2.txt => day5-input2.txt +1 -0
@@ 0,0 1,1 @@ 3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31, 1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104, 999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99
M intcode.lisp => intcode.lisp +127 -25
@@ 12,9 12,6 @@ ((memory :initarg :memory :accessor memory) (memory-size :initarg :memory-size :accessor memory-size) (instruction-pointer :initarg :instruction-pointer :initform 0 @@ 34,39 31,144 @@ `(with-slots ,rest *intcode* ,@body)) (defparameter *increment-counter* 4) (defun parse-instruction (instruction) (let ((i (format nil "~5,'0d" instruction))) ;; KLUDGE: This thing does too many things. ;; Handle case for halt value better, and maybe split the mv-bind? (values (if (string= (subseq i 3) "99") 99 (parse-integer (subseq i 4))) (reverse (mapcar #'parse-integer (split "" (subseq i 0 3))))))) (defmacro with-modes (&body body) "Anaphoric MODES variables" `(let* ((modes (nth-value 1 (parse-instruction (get-mem 1 (instruction-pointer *intcode*))))) (first-param-mode (car modes)) (second-param-mode (cadr modes))) ,@body)) (defmacro with-x (&body body) "Anaphoric X value" `(let ((x (+ (instruction-pointer *intcode*) 1))) ,@body)) (defmacro with-xy (&body body) "Anaphoric X Y values" `(let ((x (+ (instruction-pointer *intcode*) 1)) (y (+ (instruction-pointer *intcode*) 2))) ,@body)) (defmacro with-xyz (&body body) "Anaphoric X Y Z values" `(let ((x (+ (instruction-pointer *intcode*) 1)) (y (+ (instruction-pointer *intcode*) 2)) (z (+ (instruction-pointer *intcode*) 3))) ,@body)) (defun actions (instruction) (ecase instruction (defun instruction (instruction) (ecase (parse-instruction instruction) (1 'add) (2 'mult) (3 'input) (4 'output) (5 'jump-if-true) (6 'jump-if-false) (7 'less-than) (8 'equals) (99 'halt))) (defun get-next-action () (defun next-instruction () (with-intcode (memory instruction-pointer) (actions (aref memory instruction-pointer)))) (defmacro def-instruction (name operation) `(defun ,name () (with-intcode (instruction-pointer memory) (let ((x (+ instruction-pointer 1)) (y (+ instruction-pointer 2)) (z (+ instruction-pointer 3))) (incf instruction-pointer *increment-counter*) (setf (aref memory (aref memory z)) (,operation (aref memory (aref memory x)) (aref memory (aref memory y)))))))) (def-instruction add +) (def-instruction mult *) (instruction (aref memory instruction-pointer)))) (defun (setf set-mem) (value position) (with-intcode (memory) (setf (aref memory (aref memory position)) value))) (defun get-mem (mode position) (with-intcode (memory) (if (zerop mode) (aref memory (aref memory position)) (aref memory position)))) (defmacro with-instruction-pointer (&body body) `(with-intcode (instruction-pointer) ,@body)) (defmacro with-binary-expr (&body body) `(with-instruction-pointer (with-xyz (with-modes ,@body (incf instruction-pointer 4))))) (defmacro with-jump (&body body) `(with-instruction-pointer (with-xy (with-modes ,@body (incf instruction-pointer 3))))) (defmacro with-io (&body body) `(with-instruction-pointer (with-x ,@body (incf instruction-pointer 2)))) (defun add () (with-binary-expr (setf (set-mem z) (+ (get-mem first-param-mode x) (get-mem second-param-mode y))))) (defun mult () (with-binary-expr (setf (set-mem z) (* (get-mem first-param-mode x) (get-mem second-param-mode y))))) (defun input () (with-io (setf (set-mem x) (parse-integer (read-line))))) (defun output () (with-io (print (get-mem 0 x)))) (defun jump-if-true () (with-jump (unless (zerop (get-mem first-param-mode x)) (setf instruction-pointer (get-mem second-param-mode y)) (return-from jump-if-true)))) (defun jump-if-false () (with-jump (when (zerop (get-mem first-param-mode x)) (setf instruction-pointer (get-mem second-param-mode y)) (return-from jump-if-false)))) (defun less-than () (with-binary-expr (if (< (get-mem first-param-mode x) (get-mem second-param-mode y)) (setf (set-mem z) 1) (setf (set-mem z) 0)))) (defun equals () (with-binary-expr (if (= (get-mem first-param-mode x) (get-mem second-param-mode y)) (setf (set-mem z) 1) (setf (set-mem z) 0)))) (defun halt () :halt) (defun init-intcode (filename) (let* ((op-codes (read-op-codes filename)) (mem-size (length op-codes))) (with-intcode (memory instruction-pointer memory-size) (setf memory-size mem-size) (with-intcode (memory instruction-pointer) (setf instruction-pointer 0) (setf memory (make-array mem-size :initial-contents op-codes)) :initialized))) @@ 74,7 176,7 @@ "Makes an assumption that memory is set, either from INIT-INTCODE or manually." (with-intcode (memory instruction-pointer) (setf instruction-pointer 0) (do* ((action (get-next-action) (get-next-action))) (do* ((action (next-instruction) (next-instruction))) ((eql action 'halt) (aref memory 0)) (funcall action))))