#lang racket
(require bitsyntax)

(define raw-in (car (port->lines (open-input-file "day16.txt") #:close? #t))) ;only 1 line this time
(define (hexstring->blist hs)
  (integer->bit-string (string->number hs 16) (* 4 (string-length hs)) #t))
(define (parse tape)
  (define (parse-packet b)
    (bit-string-case b
                     ([(v :: bits 3) (= 4 :: bits 3) (rest :: binary)] ;literal
                      (match-define (list next len val) (parse-literal rest))
                      `((,v literal ,val) ,(+ 6 (* 5 len)) ,next))
                     ([(v :: bits 3) (op :: bits 3) (= 0 :: bits 1) (l :: bits 15) (rest :: binary)] ; type 0 operator
                      (match-define (list ps next len) (parse-operator0 rest l))
                      `((,v operator ,op ,ps) ,(+ 22 len) ,next))
                     ([(v :: bits 3) (op :: bits 3) (= 1 :: bits 1) (l :: bits 11) (rest :: binary)] ; type 1 operator
                      (match-define (list ps next len) (parse-operator1 rest l))
                      `((,v operator ,op ,ps) ,(+ 18 len) ,next))))
  (define (parse-literal b)
    (bit-string-case b
                     ([(= 1 :: bits 1) (v :: bits 4) (rest :: binary)]
                      (begin
                        (match-define (list next len val) (parse-literal rest))
                        (list next (+ 1 len) (+ (* (expt 16 len) v) val))))
                     ([(= 0 :: bits 1) (v :: bits 4) (rest :: binary)] (list rest 1 v))))
  (define (parse-n-bits n b [lsf 0])
    (cond
      [(<= n lsf) b]
      [else (match-define (list-rest packet (list len next)) (parse-packet b))
            (cons packet (parse-n-bits n next (+ lsf len)))]))

  (define (parse-n-packets n b [lsf 0])
    (cond
      [(= n 0) (λ () (list b lsf))]
      [else (match-define (list-rest packet (list len next)) (parse-packet b))
            (cons packet (parse-n-packets (sub1 n) next (+ lsf len)))]))

  (define (parse-operator0 b len)
    (match-define (list-rest ps ... next) (parse-n-bits len b))
    (list ps next len))

  (define (parse-operator1 b len)
    (match-define (list-rest ps ... thnk) (parse-n-packets len b))
    (match-define (list next lsf) (thnk))
    (list ps next lsf))

  (car (parse-packet tape)))

(define (part1 in)
  (version-sum (parse (hexstring->blist in))))

(define (version-sum pl)
  (cond
    [(eq? (cadr pl) 'literal) (car pl)]
    [else (+ (car pl) (apply + (map version-sum (cadddr pl))))]))

(define (eval-ps pl)
  (define flist `((0 ,+) (1 ,*) (2 ,min) (3 ,max)
                         (5 ,(λ (x y) (if (> x y) 1 0)))
                         (6 ,(λ (x y) (if (< x y) 1 0)))
                         (7 ,(λ (x y) (if (= x y) 1 0)))))
    (cond
      [(eq? (cadr pl) 'literal) (caddr pl)]
      [else (apply (cadr (assoc (caddr pl) flist)) (map eval-ps (cadddr pl)))]))

(define (part2 in)
  (eval-ps (parse (hexstring->blist in))))