1 files changed, 101 insertions, 0 deletions
diff --git a/2021/16/code.tl b/2021/16/code.tl
new file mode 100644
index 0000000..8f2016e
--- /dev/null
+++ b/2021/16/code.tl
@@ -0,0 +1,101 @@
+(defstruct bitstream ()
+  bf
+  st
+  pfx
+  (count 0))
+
+(defstruct packet ()
+  version
+  type
+  payload)
+
+(defmeth bitstream read-file (bs : (name "input"))
+  bs.(read-string (file-get-string name)))
+
+(defmeth bitstream read-string (bs s)
+  (set bs.bf (buf-uint (toint s 16))
+       bs.st (make-buf-stream bs.bf))
+  bs.(ensure-prefix 24))
+
+(defmeth bitstream ensure-prefix (bs n)
+  (whilet ((b (and (< (len bs.pfx) n) (get-byte bs.st))))
+    (upd bs.pfx (nconc @1 (flow b (+ 256) (digits @1 2) cdr))))
+  bs)
+
+(defmeth bitstream set-pfx (bs npfx)
+  (placelet ((pfx (read-once bs.pfx))
+             (count (read-once bs.count)))
+    (while (neq pfx npfx)
+      (inc count)
+      (upd pfx cdr)))
+  bs.(ensure-prefix 24))
+
+(defmeth bitstream drop-zeros (bs)
+  (while-match (0 . @rest) bs.pfx
+    bs.(set-pfx rest))
+  bs)
+
+(defmacro val (. bits)
+  ^(poly 2 (list ,*bits)))
+
+(defmeth bitstream parse-header (bs)
+  (match (@v2 @v1 @v0 @t2 @t1 @t0 . @rest)
+         bs.pfx
+    bs.(set-pfx rest)
+    (new packet
+         version (val v2 v1 v0)
+         type (val t2 t1 t0))))
+
+(defmeth packet parse-payload (pk bs)
+  (caseq pk.type
+    (4 (let ((value 0))
+         (while-match (@more @v3 @v2 @v1 @v0 . @rest) bs.pfx
+           bs.(set-pfx rest)
+           (upd value (* 16) (+ (val v3 v2 v1 v0)))
+           (if (zerop more)
+             (return)))
+         (set pk.payload value)))
+    (t (match-case bs.pfx
+         ((0 . @rest)
+          bs.(set-pfx (drop 15 rest))
+          (let ((nbits (poly 2 (take 15 rest)))
+                (count bs.count))
+            (set pk.payload
+                 (build
+                   (while (< (- bs.count count) nbits)
+                     (add bs.(parse-header).(parse-payload bs)))))))
+         ((1 . @rest)
+          bs.(set-pfx (drop 11 rest))
+          (let ((npkt (poly 2 (take 11 rest))))
+            (set pk.payload
+                 (build
+                   (dotimes (i npkt)
+                     (add bs.(parse-header).(parse-payload bs))))))))))
+  pk)
+
+(defmeth packet version-sum (pk)
+  (+ pk.version
+     (ifa (listp pk.payload)
+       (sum it .(version-sum))
+       0)))
+
+(defun get-packet (: (name "input"))
+  (let* ((bs (new bitstream).(read-file name).(drop-zeros)))
+    bs.(parse-header).(parse-payload bs)))
+
+(defun compile-packet (pk)
+  (let ((mathfun (relate '(0 1 2 3) '(+ * min max) nil))
+        (relfun (relate '(5 6 7) '(> < =) nil)))
+    (match-case pk
+      (@(struct packet type 4 payload @(integerp @literal)) literal)
+      (@(struct packet type @(@fun [mathfun]) payload @args) ^(,fun ,*[mapcar compile-packet args]))
+      (@(struct packet type @(@fun [relfun]) payload @args) ^(if (,fun ,*[mapcar compile-packet args]) 1 0))
+      (@else (error "invalid syntax ~s" else)))))
+
+(defun solve-one (: (name :))
+  (let ((pk (get-packet name)))
+    pk.(version-sum)))
+
+(defun solve-two (: (name :))
+  (let ((pk (get-packet name)))
+    (eval (compile-packet pk))))