(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 whitespace into list of words
  (define (string-split str)
    (map list->string (list-split char-whitespace? (string->list str))))

  ; Evaluate a test of the form: `rval' `test' `rlit'
  (define (satisfied? rval test rlit)
    (cond
      ((string=? test "<" ) (<  rval rlit))
      ((string=? test "<=") (<= rval rlit))
      ((string=? test "==") ( = rval rlit))
      ((string=? test ">=") (>= rval rlit))
      ((string=? test ">" ) (>  rval rlit))
      (else (not (= rval rlit)))))

  ; To copy the register state list from one cycle to the next, the usual
  ; `(apply list xs)' trick isn't good enough, because `xs' contains pairs.
  (define (list-deep-copy xs)
    (if (not (pair? xs))
        xs
        (cons (list-deep-copy (car xs)) (list-deep-copy (cdr xs)))))

  ; Execute one instruction (`words') given current state (`registers-old')
  (define (execute words registers-old)
    ; Make a copy of the input state, to be modified and returned.
    ; The state is an association list of (register . value) pairs.
    (define registers-new (list-deep-copy registers-old))
    ; "Parse" the instruction, which has the following form:
    ; `wreg' (inc|dec) `wlit' if `rreg' `test' `rlit'
    (define wreg (list-ref words 0))
    (define inc? (string=? "inc" (list-ref words 1)))
    (define wlit (string->number (list-ref words 2)))
    (define rreg (list-ref words 4))
    (define test (list-ref words 5))
    (define rlit (string->number (list-ref words 6)))
    ; If register `wreg' isn't initialized yet, set it to zero
    (if (not (assoc wreg registers-old))
        (set! registers-new (cons (cons wreg 0) registers-new)))
    ; If register `rreg' isn't initialized yet, set it to zero
    (if (not (assoc rreg registers-old))
        (set! registers-new (cons (cons rreg 0) registers-new)))
    ; Read the values stored in registers `rreg' and `wreg'
    (let ((wval (cdr (assoc wreg registers-new)))
          (rval (cdr (assoc rreg registers-new))))
      (if (satisfied? rval test rlit)
          ; If the test condition is true, apply the increment/decrement
          (set-cdr! (assoc wreg registers-new)
                    (if inc?
                        (+ wval wlit)
                        (- wval wlit))))
      ; Return the new state
      registers-new))

  ; Execute the "program" and return the history of register states
  (define (solve-puzzle lines)
    (let loop ((instructions (map string-split lines))
               (registers '())
               (history '()))
      (if (null? instructions)
          history
          (let ((state (execute (car instructions) registers)))
            (loop (cdr instructions) state (cons state history))))))

  (define (solve-part1 lines)
    (define history (solve-puzzle lines))
    (apply max (map cdr (car history))))

  (define (solve-part2 lines)
    (define history (solve-puzzle lines))
    (let loop ((states history)
               (highest -999999))
      (if (null? states)
          highest
          (loop (cdr states) (max highest (apply max (map cdr (car states))))))))

)