start day23

2016/day23/input.rkt

@@ -0,0 +1,27 @@
+#lang reader "lang.rkt"
+cpy a b
+dec b
+cpy a d
+cpy 0 a
+cpy b c
+inc a
+dec c
+jnz c -2
+dec d
+jnz d -5
+dec b
+cpy b c
+cpy c d
+dec d
+inc c
+jnz d -2
+tgl c
+cpy -16 c
+jnz 1 c
+cpy 70 c
+jnz 87 d
+inc a
+inc d
+jnz d -2
+inc c
+jnz c -5

2016/day23/lang.rkt

@@ -0,0 +1,82 @@
+#lang br/quicklang ;; http://adventofcode.com/2016/day/23
+(provide read-syntax
+         (rename-out [mb #%module-begin])
+         cpy inc dec jnz tgl)
+
+(define (read-syntax path port)
+  (strip-bindings
+   #`(module mod "lang.rkt"
+       #,@(for/list ([str (in-lines port)]
+                     #:when (not (zero? (string-length str))))
+            (format-datum '(~a) str)))))
+
+(define-macro (mb INST ...)
+  #'(#%module-begin
+     (report 'INST) ...
+     (define insts (vector INST ...))
+     (define regs (make-hash '((a . 0)(b . 0)(c . 0)(d . 0))))
+     (println (solve insts regs))
+     (hash-set! regs 'c 1)
+     (println (solve insts regs))))
+
+(define current-toggles (make-parameter empty))
+(define current-ptr (make-parameter #f))
+
+(define (toggled?) (member (current-ptr) (current-toggles)))
+
+(define (solve insts regs)
+  (let loop ([ptr 0])
+    (current-ptr ptr)
+    (if (>= ptr (vector-length insts))
+        regs
+        (loop (+ ptr (let ([move ((vector-ref insts ptr) regs)])
+                       (if (void? move) 1 move)))))))
+
+(define-macro (make-tgl-base X)
+  #'(λ(regs)
+      (current-toggles
+       ((if (member X (current-toggles))
+            remove
+            cons) X (current-toggles)))))
+
+(define-macro (tgl X)
+  #'(λ(regs)
+      ((if (toggled?)
+          (make-inc-base X)
+          (make-tgl-base X)) regs)))
+
+(define-macro (make-cpy-base X Y)
+  #'(λ(regs)
+      (define val (if (number? 'X) 'X (hash-ref regs 'X)))
+      (hash-set! regs 'Y val)))
+
+(define-macro (cpy X Y)
+  #'(λ(regs)
+      ((if (toggled?)
+        (make-jnz-base X Y)
+        (make-cpy-base X Y)) regs)))
+
+(define-macro (make-dec-base X) #'(λ(regs) (hash-update! regs 'X sub1)))
+(define-macro (make-inc-base X) #'(λ(regs) (hash-update! regs 'X add1)))
+
+(define-macro (inc X) #'(λ(regs)
+                          ((if (toggled?)
+                              (make-dec-base X)
+                              (make-inc-base X)) regs)))
+
+(define-macro (dec X) #'(λ(regs)
+                          ((if (toggled?)
+                            (make-inc-base X)
+                            (make-dec-base X)) regs)))
+
+
+(define-macro (make-jnz-base X Y)
+  #'(λ(regs)
+      (when (not (zero? (if (number? 'X) 'X (hash-ref regs 'X))))
+        Y)))
+
+(define-macro (jnz X Y)
+  #'(λ(regs)
+      ((if (toggled?)
+        (make-copy-base X Y)
+        (make-jnz-base X Y)) regs)))

2016/day23/test.rkt

@@ -0,0 +1,2 @@
+#lang reader "lang.rkt"
+cpy 2 a