baf889db8d40

--- a/.lispwords	Sat Dec 07 00:59:04 2019 -0500
+++ b/.lispwords	Sat Dec 07 16:58:32 2019 -0500
@@ -2,3 +2,4 @@
 (3 define-problem)
 (1 opcase)
 (1 finding-first)
+(1 rebind)

--- a/advent.asd	Sat Dec 07 00:59:04 2019 -0500
+++ b/advent.asd	Sat Dec 07 16:58:32 2019 -0500
@@ -31,6 +31,7 @@
                :pileup
                :split-sequence
                :str
+               :jpl-queues
 
                )
 

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/data/2019/07.txt	Sat Dec 07 16:58:32 2019 -0500
@@ -0,0 +1,1 @@
+3,8,1001,8,10,8,105,1,0,0,21,34,51,64,81,102,183,264,345,426,99999,3,9,102,2,9,9,1001,9,4,9,4,9,99,3,9,101,4,9,9,102,5,9,9,1001,9,2,9,4,9,99,3,9,101,3,9,9,1002,9,5,9,4,9,99,3,9,102,3,9,9,101,3,9,9,1002,9,4,9,4,9,99,3,9,1002,9,3,9,1001,9,5,9,1002,9,5,9,101,3,9,9,4,9,99,3,9,102,2,9,9,4,9,3,9,101,1,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,101,1,9,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,102,2,9,9,4,9,99,3,9,101,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,99,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,101,1,9,9,4,9,3,9,101,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,1002,9,2,9,4,9,99,3,9,1001,9,1,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,99,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,101,1,9,9,4,9,99

--- a/package.lisp	Sat Dec 07 00:59:04 2019 -0500
+++ b/package.lisp	Sat Dec 07 16:58:32 2019 -0500
@@ -36,6 +36,8 @@
     :first-character
     :let-result
     :let-complex
+    :queue-thunk
+    :rebind
 
     :ring
     :ring-prev

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/days/day-07.lisp	Sat Dec 07 16:58:32 2019 -0500
@@ -0,0 +1,67 @@
+(defpackage :advent/2019/07 #.cl-user::*advent-use*
+  (:shadow :queue))
+(in-package :advent/2019/07)
+
+(defun queue (&key initial-contents)
+  (let-result (queue (make-instance 'jpl-queues:synchronized-queue
+                       :queue (make-instance 'jpl-queues:unbounded-fifo-queue)))
+    (dolist (el initial-contents)
+      (jpl-queues:enqueue el queue))))
+
+(defun make-amplifier (program input-queue output-queue)
+  (advent/intcode:init program
+                       :input (rcurry #'jpl-queues:dequeue input-queue)
+                       :output (rcurry #'jpl-queues:enqueue output-queue)))
+
+(defun make-amplifiers (program phases)
+  (iterate
+    (with top-queue = (queue :initial-contents (list (first phases) 0)))
+    (for (nil next-phase) :on phases)
+    (for output-queue = (if next-phase
+                          (queue :initial-contents (list next-phase))
+                          top-queue))
+    (for input-queue :previous output-queue :initially top-queue)
+    (collect (make-amplifier program input-queue output-queue) :into amps)
+    (returning amps top-queue)))
+
+(defun run-amplifiers (program phases)
+  (multiple-value-bind (amplifiers queue) (make-amplifiers program phases)
+    (-<> amplifiers
+      (mapcar (lambda (amp)
+                (bt:make-thread (curry #'advent/intcode:run-machine amp)
+                                :name "Amplifier Thread"))
+              <>)
+      (map nil #'bt:join-thread <>))
+    (jpl-queues:dequeue queue)))
+
+(defun maximum-permutation (function sequence)
+  (iterate (alexandria:map-permutations
+             (lambda (el)
+               (maximizing (funcall function el)))
+             sequence)
+           (finish)))
+
+(define-problem (2019 7) (data read-numbers) (46248 54163586)
+  (values
+    (maximum-permutation (curry #'run-amplifiers data) '(0 1 2 3 4))
+    (maximum-permutation (curry #'run-amplifiers data) '(5 6 7 8 9))))
+
+
+#; Scratch --------------------------------------------------------------------
+
+(run '(3 15 3 16 1002 16 10 16 1 16 15 15 4 15 99 0 0))
+
+(run '(3 23 3 24 1002 24 10 24 1002 23 -1 23 101 5 23 23 1 24 23 23 4 23 99 0 0))
+
+(run '(3 26 1001 26 -4 26 3 27 1002 27 2 27 1 27 26 27 4 27 1001 28 -1 28 1005 28 6 99 0 0 5))
+
+(run '(3 52 1001 52 -5 52 3 53 1 52 56 54 1007 54 5 55 1005 55 26 1001 54 -5 54
+       1105 1 12 1 53 54 53 1008 54 0 55 1001 55 1 55 2 53 55 53 4 53 1001 56
+       -1 56 1005 56 6 99 0 0 0 0 10))
+
+(defun kill-amplifiers ()
+  (-<> (bt:all-threads)
+    (remove "Amplifier Thread" <> :test-not #'string= :key #'bt:thread-name)
+    (map nil #'bt:destroy-thread <>)))
+
+(kill-amplifiers)

--- a/src/2019/intcode.lisp	Sat Dec 07 00:59:04 2019 -0500
+++ b/src/2019/intcode.lisp	Sat Dec 07 16:58:32 2019 -0500
@@ -1,27 +1,28 @@
 (defpackage :advent/intcode
   #.cl-user::*advent-use*
   (:shadow :step :trace)
-  (:export :init :step :run))
+  (:export :init :step :run :run-machine))
 
 (in-package :advent/intcode)
 
+(defparameter *trace-lock* (bt:make-lock "intcode trace lock"))
 
 ;;;; Data Structures ----------------------------------------------------------
 (defclass* machine ()
-  ((pc :type '(integer 0) :initform 0)
-   (memory :type 'vector)
-   (input :type 'function)
-   (output :type 'function)))
+  ((pc :type (integer 0) :initform 0)
+   (memory :type (vector integer))
+   (input :type function)
+   (output :type function)))
 
 (define-with-macro machine pc memory input output)
 
 
 (defclass* operation ()
   ((opcode :type (integer 0))
-   (name :type 'symbol)
-   (size :type '(integer 1))
-   (parameters :type 'list)
-   (perform :type 'function)))
+   (name :type symbol)
+   (size :type (integer 1))
+   (parameters :type list)
+   (perform :type function)))
 
 (defun perform-operation (opcode parameter-modes machine)
   (funcall (perform (gethash opcode *operations*))
@@ -54,24 +55,26 @@
       `(progn
          (defun ,function-name (,pmodes ,machine)
            (declare (ignorable ,pmodes))
-           (flet ((pop-mode ()
-                    (multiple-value-bind (,pms ,pm) (truncate ,pmodes 10)
-                      (setf ,pmodes ,pms)
-                      ,pm)))
-             (with-machine (,machine)
-               (let (,@(iterate
-                         (for (param kind) :in parameters)
-                         (for offset :from 0)
-                         (collect
-                           (ecase kind
-                             (in `(,param (retrieve ,machine
-                                                    (pop-mode)
-                                                    (aref memory (+ pc ,offset)))))
-                             (out `(,param (progn
-                                             (pop-mode)
-                                             (aref memory (+ pc ,offset)))))))))
-                 (incf pc ,(length parameters))
-                 ,@body))))
+           (,@(if parameters
+                `(flet ((pop-mode ()
+                          (multiple-value-bind (,pms ,pm) (truncate ,pmodes 10)
+                            (setf ,pmodes ,pms)
+                            ,pm))))
+                `(progn))
+            (with-machine (,machine)
+              (let (,@(iterate
+                        (for (param kind) :in parameters)
+                        (for offset :from 0)
+                        (collect
+                          (ecase kind
+                            (in `(,param (retrieve ,machine
+                                                   (pop-mode)
+                                                   (aref memory (+ pc ,offset)))))
+                            (out `(,param (progn
+                                            (pop-mode)
+                                            (aref memory (+ pc ,offset)))))))))
+                (incf pc ,(length parameters))
+                ,@body))))
          (setf (gethash ,opcode *operations*)
                (make-instance 'operation
                  :opcode ,opcode
@@ -172,17 +175,21 @@
 (defun step (machine &key trace)
   (with-machine (machine)
     (when trace
-      (disassemble-program (memory machine) :start pc :limit 1))
+      (bt:with-lock-held (*trace-lock*)
+        (when (numberp trace)
+          (format t "~D: " trace))
+        (disassemble-program (memory machine) :start pc :limit 1)))
     (multiple-value-bind (opcode parameter-modes) (parse-op (aref memory pc))
       (incf pc)
       (perform-operation opcode parameter-modes machine))))
 
-(defun run (program &key input output trace)
+(defun run-machine (machine &key trace)
   (iterate
-    (with machine = (init program :input input :output output))
     (case (step machine :trace trace)
       (:halt (return (aref (memory machine) 0))))))
 
+(defun run (program &key input output trace)
+  (run-machine (init program :input input :output output) :trace trace))
 
 ;; #; Scratch --------------------------------------------------------------------
 

--- a/src/utils.lisp	Sat Dec 07 00:59:04 2019 -0500
+++ b/src/utils.lisp	Sat Dec 07 16:58:32 2019 -0500
@@ -474,6 +474,17 @@
      ,@body))
 
 
+(defun queue-thunk (&rest elements)
+  (lambda () (pop elements)))
+
+
+(defmacro rebind ((&rest vars) &body body)
+  `(let (,@(iterate
+             (for var :in vars)
+             (collect `(,var ,var))))
+     ,@body))
+
+
 ;;;; A* Search ----------------------------------------------------------------
 (defstruct path
   state