Day 7: Part 2 done.

lib.rkt

@@ -8,6 +8,7 @@
          sum
          neq?
          nzero?
+         rac
          list-ref*
          number->digits-reverse
          number->digits)
@@ -40,6 +41,11 @@
 (define (nzero? n)
   (not (zero? n)))
 
+;; rac : (listof any) -> any -> (listof any)
+;; Append element to the back of the list.
+(define (rac lst v)
+  (append lst (list v)))
+
 ;; list-ref* : (listof any) -> number -> any -> any
 ;; Same as list-ref, except a default value is provided
 ;; if the index is beyond the length of the list.

src/07.rkt

@@ -1,6 +1,7 @@
 #lang racket
 
-(require "../lib.rkt"
+(require data/queue
+         "../lib.rkt"
          "05.rkt")
 
 (define input
@@ -18,8 +19,9 @@
     (let ([phases (permutations '(0 1 2 3 4))])
       (apply max (append (map amplify phases)))))
 
-;; The IntCode interpreter from Day 5, except it uses threads
+(struct state (program pointer input) #:transparent)
-(define (exec-pipe program #:ptr [pointer 0] #:thr thread)
+
+(define (exec-state program #:ptr [pointer 0] #:in [input '()])
   (let* ([instruction (list-ref program pointer)]
          [opcode (remainder instruction 100)]
          [mode1 (remainder (quotient instruction 100) 10)]
@@ -44,45 +46,44 @@
        (let* ([arith (match opcode [1 +] [2 *])]
               [value (arith (v1) (v2))]
               [program (list-set program (l3) value)])
-         (exec-pipe program #:ptr next-pointer #:thr thread))]
+         (exec-state program #:ptr next-pointer #:in input))]
       [3
-       (let* ([value (thread-receive)]
+       (let* ([value (car input)]
+              [input (cdr input)]
               [program (list-set program (l1) value)])
-         (exec-pipe program #:ptr next-pointer #:thr thread))]
+         (exec-state program #:ptr next-pointer #:in input))]
       [4
-       (thread-send thread (v1))
+       (values 'yield (v1)
-       (exec-pipe program #:ptr next-pointer #:thr thread)]
+               (state program next-pointer input))]
       [(or 5 6)
        (let* ([jump-if (match opcode [5 nzero?] [6 zero?])]
               [next-pointer (if (jump-if (v1)) (v2) next-pointer)])
-         (exec-pipe program #:ptr next-pointer #:thr thread))]
+         (exec-state program #:ptr next-pointer #:in input))]
       [(or 7 8)
        (let* ([lt-eq (match opcode [7 <] [8 =])]
               [value (if (lt-eq (v1) (v2)) 1 0)]
               [program (list-set program (l3) value)])
-         (exec-pipe program #:ptr next-pointer #:thr thread))]
+         (exec-state program #:ptr next-pointer #:in input))]
       [99
-       (thread-send thread (values program (thread-receive)))])))
+       (values 'halt (car input)
+               (state program next-pointer (cdr input)))])))
 
 (define (amplify-loop phase)
-  (let* ([threadE (thread (exec-pipe input #:thr (current-thread)))]
+  (let* ([amps (map (compose (curry state input 0) list) phase)]
-         [threadD (thread (exec-pipe input #:thr threadE))]
+         [Q (make-queue)])
-         [threadC (thread (exec-pipe input #:thr threadD))]
+    (map (curry enqueue! Q) amps)
-         [threadB (thread (exec-pipe input #:thr threadC))]
+    (let loop ([signal 0])
-         [threadA (thread (exec-pipe input #:thr threadB))])
+      (let* ([amp (dequeue! Q)])
-    (thread-send threadE (fifth  phase))
+        (let-values ([(code signal amp)
-    (thread-send threadD (fourth phase))
+                      (exec-state (state-program amp)
-    (thread-send threadC (third  phase))
+                            #:ptr (state-pointer amp)
-    (thread-send threadB (second phase))
+                            #:in (rac (state-input amp) signal))])
-    (thread-send threadA (first phase))
+          (match code
-    (thread-send threadA 0)
+            ['yield (enqueue! Q amp) (loop signal)]
-    (let loop ()
+            ['halt signal]))))))
-      (let ([msg (thread-receive)])
-        (if (number? msg)
-            (begin
-              (thread-send threadA msg)
-              (loop))
-            (let-values ([(_ output) msg])
-              output))))))
 
-(show-solution part1 #f)
+(define part2
+  (let ([phases (permutations '(5 6 7 8 9))])
+    (apply max (map amplify-loop phases))))
+
+(show-solution part1 part2)