Ben / Nujel

#!/usr/bin/env nujel

[defun bits/hex->bits [s]
       [string/pad-start [int->string/binary [read/single [cat "#x" s]]] 4 "0"]]

[defun bits/read-value [s offset len]
       [read/single [cat "#b" [substr s offset [+ offset len]]]]]

[defun bits/> [a b] [if [> a b] 1 0]]
[defun bits/< [a b] [if [< a b] 1 0]]
[defun bits/= [a b] [if [== a b] 1 0]]
[defun bits/type->op [t]
       [cond [[== t 0] +]
	     [[== t 1] *]
	     [[== t 2] min]
	     [[== t 3] max]
	     [[== t 5] bits/>]
	     [[== t 6] bits/<]
	     [[== t 7] bits/=]]]
[defun bits/type->op [t]
       [case t
             [0 +]
	     [1 *]
	     [2 min]
	     [3 max]
	     [5 bits/>]
	     [6 bits/<]
	     [7 bits/=]]]
[defun bits/compile [p]
       [if [== 4 [p :type]]
	   [p :value]
	   [cons [bits/type->op [p :type]] [map [p :value] bits/compile]]]]

[defun bits/parse/packet/operator/packets [p s offset packets]
       [def off offset]
       [for [i 0 packets]
	    [def child [bits/parse/packet s off]]
	    [tree/set! p :value [cons [cdr child] [p :value]]]
	    [set! off [car child]]]
       [tree/set! p :value [nreverse [p :value]]]
       [cons off p]]

[defun bits/parse/packet/operator/bits [p s offset bits]
       [def off offset]
       [def goal-offset [+ offset bits]]

       [while [< off goal-offset]
	      [def child [bits/parse/packet s off]]
	      [tree/set! p :value [cons [cdr child] [p :value]]]
	      [set! off [car child]]]
       [tree/set! p :value [nreverse [p :value]]]
       [cons off p]]

[defun bits/parse/packet/operator [p s offset]
       [if [== [char-at s offset] #\1]
           [bits/parse/packet/operator/packets p s [+ offset 12] [bits/read-value s [+ 1 offset] 11]]
           [bits/parse/packet/operator/bits p s [+ offset 16] [bits/read-value s [+ 1 offset] 15]]]]

[defun bits/parse/packet/literal [p s offset]
       [def parts #nil]
       [def off offset]
       [while [== [char-at s off] #\1]
	      [++ off]
	      [set! parts [cons [substr s off [+ 4 off]] parts]]
	      [+= off 4]]
       [++ off]
       [set! parts [cons [substr s off [+ 4 off]] parts]]
       [+= off 4]
       [cons off [tree/set! p :value [read/single [cat "#b" [join [nreverse parts]]]]]]]

[defun bits/parse/packet-contents [p s offset]
       [case [p :type]
	     [4 [bits/parse/packet/literal p s offset]]
	     [otherwise [bits/parse/packet/operator p s offset]]]]

[defun bits/parse/packet [s offset]
       [-> @[:version [bits/read-value s offset 3]
             :type [bits/read-value s [+ 3 offset] 3]]
	   [bits/parse/packet-contents s [+ offset 6]]]]

[defun bits/parse/hex [s]
       [bits/parse/packet [join [map [split s ""] bits/hex->bits]] 0]]

[defun bits/version-sum [p]
       [if [pair? [p :value]]
           [reduce [p :value] [\ [a b] [+ a [bits/version-sum b]]] [p :version]]
	   [p :version]]]

[defun bits/print [p indent]
       [when-not indent [set! indent 0]]
       [case [p :type]
	      [4 [println [cat [string/pad-start "" indent]
				      [ansi-blue [p :value]]
				      " v:" [ansi-green [p :version]]]]]
	      [otherwise [println [cat [string/pad-start "" indent]
				      [ansi-yellow [p :type]]
				      " v:" [ansi-green [p :version]]]]
			 [for-each [p :value] [\ [a] [bits/print a [+ 4 indent]]]]]]]

[def parsed-prog [cdr [bits/parse/hex [file/read "tests/fast/day16.input"]]]]
;[bits/print parsed-prog]
;[println [str/write [bits/compile parsed-prog]]]
					;[newline]
[def res-p1 [bits/version-sum parsed-prog]]
[def res-p2 [eval [bits/compile parsed-prog]]]
[when [!= res-p1 951]
      [throw [list :wrong-result "Wrong result" res-p1]]]
[when [!= res-p2 902198718880]
      [throw [list :wrong-result "Wrong result" res-p2]]]