@@ 1,22 1,24 @@
(in-package :intcode)
-(defun run (&rest args)
- (init-intcode "./day7-input.txt")
+(defparameter *i* (make-instance 'intcode))
+(defun run-day7-part-one (intcode &rest args)
+ (init-intcode "./day7-input.txt" intcode)
(let ((result 0))
(dolist (arg args result)
- (with-intcode (instruction-pointer)
- (setf instruction-pointer 0)
- (let ((action (next-instruction)))
- (funcall action arg) ;; do first read instruction
- (do ((action (next-instruction) (next-instruction)))
- ((eql action 'halt)
- (setf result (get-mem 0 (1- instruction-pointer))))
- (cond ((eql action 'input)
- (funcall action result))
- ((eql action 'output)
- (funcall action nil))
- (t (funcall action)))))))))
+ (with-intcode intcode
+ (with-instruction-pointer
+ (setf instruction-pointer 0)
+ (let ((action (next-instruction)))
+ (funcall action arg) ;; do first read instruction
+ (do ((action (next-instruction) (next-instruction)))
+ ((eql action 'halt)
+ (setf result (get-mem 0 (1- instruction-pointer))))
+ (cond ((eql action 'input)
+ (funcall action result))
+ ((eql action 'output)
+ (funcall action nil))
+ (t (funcall action))))))))))
(defun all-permutations (list)
(cond ((null list) nil)
@@ 27,7 29,7 @@
(defun day7-part-one ()
(let (result)
- (mapcar (lambda (x) (push (apply #'run x) result))
+ (mapcar (lambda (x) (push (apply #'run-day7-part-one *i* x) result))
(all-permutations '(0 1 2 3 4)))
(car (sort result #'>))))
@@ 8,29 8,35 @@
(in-package :intcode)
+(defmacro with-gensyms (syms &body body)
+ `(let ,(mapcar (lambda (sym) `(,sym (gensym))) syms)
+ ,@body))
+
(defclass intcode ()
((memory
:initarg :memory
:accessor memory)
+ (setting
+ :initarg :setting
+ :accessor setting)
+ (out-buffer
+ :initarg :out-buffer
+ :initform (list)
+ :accessor out-buffer)
(instruction-pointer
:initarg :instruction-pointer
:initform 0
:accessor instruction-pointer)))
-(defvar *intcode* (make-instance 'intcode))
+(defvar *intcode*)
-(defun restart-computer ()
- (setf *intcode* (make-instance 'intcode)))
+(defun restart-computer (&optional (intcode *intcode*))
+ (setf intcode (make-instance 'intcode)))
(defun read-op-codes (filename)
(with-open-file (stream filename)
(mapcar #'parse-integer (split "," (read-line stream nil nil)))))
-(defmacro with-intcode ((&rest rest) &body body)
- "Macro with hardcoded INTCODE instance. For convenience."
- `(with-slots ,rest *intcode*
- ,@body))
-
(defun parse-instruction (instruction)
(let ((i (format nil "~5,'0d" instruction)))
;; KLUDGE: This thing does too many things.
@@ 41,6 47,14 @@
(reverse (mapcar #'parse-integer
(split "" (subseq i 0 3)))))))
+(defmacro with-intcode (intcode &body body)
+ `(let ((*intcode* ,intcode))
+ ,@body))
+
+(defmacro with-internals (slots &body body)
+ `(with-slots ,slots *intcode*
+ ,@body))
+
(defmacro with-modes (&body body)
"Anaphoric MODES variables"
`(let* ((modes (nth-value
@@ 48,24 62,20 @@
(get-mem 1 (instruction-pointer *intcode*)))))
(first-param-mode (car modes))
(second-param-mode (cadr modes)))
+ (declare (ignorable modes first-param-mode second-param-mode))
,@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-positions (args &body body)
+ (let ((pointer 0))
+ `(let ,(mapcar (lambda (arg)
+ `(,arg (+ (instruction-pointer *intcode*)
+ ,(incf pointer))))
+ args)
+ (declare (ignorable ,@args))
+ ,@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)))
+(defmacro with-instruction-pointer (&body body)
+ `(with-internals (instruction-pointer)
,@body))
(defun instruction (instruction)
@@ 81,102 91,108 @@
(99 'halt)))
(defun next-instruction ()
- (with-intcode (memory instruction-pointer)
+ (with-internals (memory instruction-pointer)
(instruction (aref memory instruction-pointer))))
(defun (setf set-mem) (value position)
- (with-intcode (memory)
+ (with-internals (memory)
(setf (aref memory (aref memory position)) value)))
(defun get-mem (mode position)
- (with-intcode (memory)
+ (with-internals (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-positions (x y z)
(with-modes
,@body
(incf instruction-pointer 4)))))
(defmacro with-jump (&body body)
`(with-instruction-pointer
- (with-xy
+ (with-positions (x y)
(with-modes
,@body
(incf instruction-pointer 3)))))
(defmacro with-io (&body body)
`(with-instruction-pointer
- (with-x
+ (with-positions (x)
,@body
(incf instruction-pointer 2))))
+(defmacro jump-result (name clause)
+ `(,clause (zerop (get-mem first-param-mode x))
+ (setf instruction-pointer (get-mem second-param-mode y))
+ (return-from ,name)))
+
+(defmacro binary-result (operation)
+ `(,operation (get-mem first-param-mode x)
+ (get-mem second-param-mode y)))
+
+;;; Instruction set
+
(defun add ()
(with-binary-expr
- (setf (set-mem z) (+ (get-mem first-param-mode x)
- (get-mem second-param-mode y)))))
+ (setf (set-mem z) (binary-result +))))
(defun mult ()
(with-binary-expr
- (setf (set-mem z) (* (get-mem first-param-mode x)
- (get-mem second-param-mode y)))))
+ (setf (set-mem z) (binary-result *))))
-(defun input (&optional in)
+(defun input (in)
(with-io
(setf (set-mem x) (if in in (parse-integer (read-line))))))
(defun output (&optional (stream t))
(with-io
- (format stream "~a" (get-mem 0 x))))
+ (with-internals (out-buffer)
+ (if (out-buffer *intcode*)
+ (push (get-mem 0 x) (cdr (last (out-buffer *intcode*))))
+ (push (get-mem 0 x) (out-buffer *intcode*)))
+ (format stream "~a" (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))))
+ (jump-result jump-if-true unless)))
(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))))
+ (jump-result jump-if-false when)))
(defun less-than ()
(with-binary-expr
- (if (< (get-mem first-param-mode x)
- (get-mem second-param-mode y))
+ (if (binary-result <)
(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))
+ (if (binary-result =)
(setf (set-mem z) 1)
- (setf (set-mem z) 0))))
+ (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)
+(defun init-intcode (filename intcode &optional (start nil))
+ (with-intcode intcode
+ (let* ((op-codes (read-op-codes filename))
+ (mem-size (length op-codes)))
+ (with-internals (memory setting out-buffer instruction-pointer)
+ (setf instruction-pointer 0)
+ (setf setting start)
+ (setf out-buffer nil)
+ (setf memory (make-array mem-size :initial-contents op-codes))
+ :initialized))))
+
+(defun run (intcode)
+ "RUN dynamically binds an instance of INTCODE. "
+ (with-intcode intcode
+ (with-internals (memory instruction-pointer)
(setf instruction-pointer 0)
- (setf memory (make-array mem-size :initial-contents op-codes))
- :initialized)))
-
-(defun run-intcode ()
- "Makes an assumption that memory is set, either from INIT-INTCODE or manually."
- (with-intcode (memory instruction-pointer)
- (setf instruction-pointer 0)
- (do* ((action (next-instruction) (next-instruction)))
- ((eql action 'halt) (aref memory 0))
- (funcall action))))
-
+ (do* ((action (next-instruction) (next-instruction)))
+ ((eql action 'halt) (aref memory 0))
+ (funcall action)))))