blob: 8f2016e8399c4fd65195b6dd6930d0d8bc350818 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
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))))
|
