d18 s2

2017/d18/main2.rkt

@@ -0,0 +1,50 @@
+#lang reader "../aoc-lang.rkt"
+(provide (rename-out [#%mb #%module-begin]) ★★)
+
+(define-macro (#%mb (STARS) TOKS ...)
+  #`(#%module-begin
+     (time (STARS (vector (λ () TOKS) ...)))))
+
+(define cur-program (make-parameter #f))
+(define cur-receiver (make-parameter #f))
+
+(provide snd set add mul mod rcv jgz)
+(define-macro (value VAL) #'(let ([val 'VAL]) (if (number? val) val (hash-ref! (cur-program) val 0))))
+(define-macro (set REG VAL) #'(hash-set! (cur-program) 'REG (value VAL)))
+(define-macro (add REG VAL) #'(hash-update! (cur-program) 'REG (λ (val) (+ val (value VAL))) 0))
+(define-macro (mul REG VAL) #'(hash-update! (cur-program) 'REG (λ (val) (* val (value VAL))) 0))
+(define-macro (mod REG VAL) #'(hash-update! (cur-program) 'REG (λ (val) (modulo val (value VAL))) 0))
+(define-macro (snd VAL) #'(begin
+                            (hash-update! (cur-program) 'sends add1 0)
+                            (hash-update! (cur-receiver) 'msgs (λ (vals) (append vals (list (value VAL)))) null)))
+(define-macro (rcv REG) #'(let ([msgs (hash-ref! (cur-program) 'msgs null)])
+                            (when (empty? msgs)
+                              (hash-set! (cur-program) 'waiting #t)
+                              (raise 'waiting))
+                            (hash-set! (cur-program) 'waiting #f)
+                            (hash-update! (cur-program) 'msgs cdr)
+                            (hash-set! (cur-program) 'REG (car msgs))))
+(define-macro (jgz X Y) #'(when (positive? (value X)) (raise (value Y))))
+
+(define (do-inst p rcvr insts)
+  (hash-update! p 'offset (λ (offset)
+                            (+ offset
+                               (with-handlers ([(curry eq? 'waiting) (const 0)]
+                                               [integer? values])
+                                 (parameterize ([cur-program p]
+                                                [cur-receiver rcvr])
+                                   (define inst (vector-ref insts offset))
+                                   (inst))
+                                 1)))))
+
+(define (★★ insts)
+  (define p0 (make-hasheq '((p . 0))))
+  (define p1 (make-hasheq '((p . 1))))
+  (define (offset-valid? p) (<= 0 (hash-ref! p 'offset 0) (sub1 (vector-length insts))))
+  (define (waiting? p) (hash-ref! p 'waiting #f))
+  (for ([i (in-naturals)]
+        #:break (or (and (not (offset-valid? p0)) (not (offset-valid? p1)))
+                    (and (waiting? p0) (waiting? p1))))
+    (when (offset-valid? p0) (do-inst p0 p1 insts))
+    (when (offset-valid? p1) (do-inst p1 p0 insts)))
+  (hash-ref p1 'sends))

2017/d18/star2.rkt

@@ -0,0 +1,42 @@
+#lang reader "main2.rkt" ★★ ; 5969
+set i 31
+set a 1
+mul p 17
+jgz p p
+mul a 2
+add i -1
+jgz i -2
+add a -1
+set i 127
+set p 464
+mul p 8505
+mod p a
+mul p 129749
+add p 12345
+mod p a
+set b p
+mod b 10000
+snd b
+add i -1
+jgz i -9
+jgz a 3
+rcv b
+jgz b -1
+set f 0
+set i 126
+rcv a
+rcv b
+set p a
+mul p -1
+add p b
+jgz p 4
+snd a
+set a b
+jgz 1 3
+snd b
+set f 1
+add i -1
+jgz i -11
+snd a
+jgz f -16
+jgz a -19

2017/d18/test2.rkt

@@ -0,0 +1,8 @@
+#lang reader "main2.rkt" ★★ ; 3
+snd 1
+snd 2
+snd p
+rcv a
+rcv b
+rcv c
+rcv d