src/2017/days/day-18.lisp @ 8b272a80df17
Ugh
author |
Steve Losh <steve@stevelosh.com> |
date |
Thu, 12 Dec 2019 21:08:08 -0500 |
parents |
5f6c2d777533 |
children |
182bdd87fd9e |
(defpackage :advent/2017/18 #.cl-user::*advent-use*)
(in-package :advent/2017/18)
(defclass* machine ()
((id :type integer)
(program :type vector)
(pc :initform 0)
(registers :initform (make-hash-table))
(queue :initform (make-queue))
(blocked :initform nil)))
(defun reg (machine register)
(gethash register (registers machine) 0))
(defun (setf reg) (new-value machine register)
(setf (gethash register (registers machine) 0)
new-value))
(defun val (machine register-or-constant)
(etypecase register-or-constant
(symbol (reg machine register-or-constant))
(number register-or-constant)))
(defmacro opcase (op &body clauses)
(alexandria:once-only (op)
`(case (first ,op)
,@(iterate
(for ((opcode . args) . body) :in clauses)
(collect `(,opcode (destructuring-bind ,args (rest ,op)
,@body)))))))
(defun handle-common-ops (machine op)
(macrolet ((r (x) `(reg machine ,x))
(v (x) `(val machine ,x)))
(opcase op
((set x y) (setf (r x) (v y)))
((add x y) (setf (r x) (+ (v x) (v y))))
((mul x y) (setf (r x) (* (v x) (v y))))
((mod x y) (setf (r x) (mod (v x) (v y))))
((jgz x y) (when (plusp (v x))
(incf (pc machine)
(1- (v y))))))))
(defun part1 (program)
(iterate
(with machine = (make-instance 'machine :program program))
(with hz = nil)
(with bound = (length program))
(while (in-range-p 0 (pc machine) bound))
(for op = (aref (program machine) (pc machine)))
(incf (pc machine))
(handle-common-ops machine op)
(opcase op
((snd x) (setf hz (val machine x)))
((rcv x) (unless (zerop (val machine x))
(return hz))))))
(defun part2 (program)
(iterate
(with a = (make-instance 'machine :program program :id 0))
(with b = (make-instance 'machine :program program :id 1))
(with bound = (length program))
(initially (setf (reg a 'p) 0
(reg b 'p) 1))
(while (in-range-p 0 (pc a) bound))
(for op = (aref (program a) (pc a)))
(incf (pc a))
(handle-common-ops a op)
(opcase op
((snd x) (progn
(counting (= 1 (id a)))
(enqueue (val a x) (queue b))))
((rcv x) (cond ((not (queue-empty-p (queue a)))
(setf (reg a x) (dequeue (queue a))
(blocked b) nil))
((blocked b) (pr 'deadlock) (finish))
(t (progn (decf (pc a))
(setf (blocked a) t)
(rotatef a b))))))))
;; TODO finish this
;; (define-problem (2017 18) (data read-lines) (1187 5969)
;; (setf data (map 'vector #'read-all-from-string data))
;; (values (part1 data)
;; (part2 data)))
#; Scratch --------------------------------------------------------------------
(run '("set a 1"
"add a 2"
"mul a a"
"mod a 5"
"snd a"
"set a 0"
"rcv a"
"jgz a -1"
"set a 1"
"jgz a -2"))
(run '("snd 1"
"snd 2"
"snd p"
"rcv a"
"rcv b"
"rcv c"
"rcv d"))