(library (lib)
  (export solve-part1 solve-part2)
  (import (chezscheme))

  ; Split list at first delimiter into `prefix' and `suffix'
  ; Return value is a pair like `((p r e f i x) s u f f i x)'
  (define (list-split-left delimiter? xs)
    (let loop ((prefix '())
               (suffix xs))
      (if (null? suffix)
        (cons prefix suffix)
        (let ((x (car suffix)))
          (if (delimiter? x)
              ; Found first delimiter, so return immediately
              (cons prefix (cdr suffix))
              ; `x' isn't a delimiter, so append it to `prefix'
              (loop (append prefix (list x)) (cdr suffix)))))))

  ; Split list at given delimiter into list of sublists
  (define (list-split delimiter? xs)
    (let loop ((pieces '())
               (rest xs))
      (if (null? rest)
          ; Fix order and remove all empty sublists from output
          ; (which are caused by consecutive delimiters in `xs')
          (reverse (remp null? pieces))
          ; Extract next piece from `rest' and prepend it to `pieces'
          (let ((next (list-split-left delimiter? rest)))
            (loop (cons (car next) pieces) (cdr next))))))

  ; Split string at commas into list of substrings
  (define (string-split str)
    (define (char-comma? c) (char=? c #\,))
    (map list->string (list-split char-comma? (string->list str))))

  ; Reverse order of numbers in index range `[pos, pos+len)' in state
  (define (reverse-range state-old pos len)
    (define state-length (vector-length state-old))
    ; Initialize `state-new' as a copy of `state-old'
    (define state-new (apply vector (vector->list state-old)))
    (let loop ((i 0)) ; `i' is the offset from `pos'
      (if (>= i len)
          state-new
          (begin
            ; Copy `state-old[pos+i]' to `state-new[pos+len-i-1]'
            (vector-set!
              state-new
              (mod (+ pos i) state-length)
              (vector-ref
                state-old
                (mod (- (+ pos len) i 1) state-length)))
            (loop (+ i 1))))))

  ; Apply a single round of the (main phase of the) hash function
  (define (single-round lengths0 state0 pos0 skip0)
    (let loop ((lengths lengths0)
               (state   state0)
               (pos     pos0)
               (skip    skip0))
      (if (null? lengths)
          ; Once we've exhausted `lengths', return the full internal state
          (values state pos skip)
          ; Call `reverse-range' for `(car lengths)', and update state
          (loop
            (cdr lengths)
            (reverse-range state pos (car lengths))
            ; (We just let `pos' grow, ignoring circularity)
            (+ pos (car lengths) skip)
            (+ skip 1)))))

  ; Apply `single-round' `n' times, reusing the full internal state each time
  (define (multi-round n lengths state-old pos-old skip-old)
    (if (<= n 0)
        state-old
        (let-values
          (((state-new pos-new skip-new)
            (single-round lengths state-old pos-old skip-old)))
          (multi-round (- n 1) lengths state-new pos-new skip-new))))

  ; Initialize state and apply `n' rounds of knot-tying algorithm
  (define (solve-puzzle n lengths)
    (define state0 (list->vector (iota 256)))
    (multi-round n lengths state0 0 0))

  ; Convert "sparse hash" to "dense hash" as per part 2's description
  (define (sparse->dense sparse)
    ; At first, storing `state' as a vector was more convenient
    ; because of all the indexing, but now a list seems better.
    (let loop ((state (vector->list sparse))
               (dense '()))
      (if (null? state)
          (reverse dense)
          (loop
            ; Remove the first 16 elements from `sparse'
            (cddddr (cddddr (cddddr (cddddr state))))
            (cons
              ; XOR together the first 16 elements of `sparse'
              (apply bitwise-xor
                     (list-tail (reverse state) (- (length state) 16)))
              dense)))))

  (define (solve-part1 str)
    (define lengths (map string->number (string-split str)))
    (define state (solve-puzzle 1 lengths))
    (* (vector-ref state 0) (vector-ref state 1)))

  (define (solve-part2 str)
    ; For part 2, `lengths' must be initialized differently
    (define lengths
      (append (map char->integer (string->list str))
              '(17 31 73 47 23)))
    (define sparse-hash (solve-puzzle 64 lengths))
    (define dense-hash (sparse->dense sparse-hash))
    ; Convert `dense-hash' into lower-case hexadecimal representation
    (let loop ((bytes dense-hash)
               (final ""))
      (if (null? bytes)
          final
          (loop
            (cdr bytes)
            (string-append final (format #f "~(~2,'0x~)" (car bytes)))))))

)