(define (bubble-sort-list lst <<?)
  (let ((sentinel-l (cons 'sentinel lst)))
    (define (bubble-swap previous)
      (let* ((first (cdr previous))
             (second (cdr first))
             (next (cdr second)))
        (set-cdr! previous second)
        (set-cdr! second first)
        (set-cdr! first next)
        #t))
    
    (let outer-loop
      ((unsorted-idx (- (length sentinel-l) 2)))
      (if (>= unsorted-idx 0)
          (if (let inner-loop
                ((inner-idx 1)
                 (has-changed? #f)
                 (previous-cell sentinel-l))
                (if (> inner-idx unsorted-idx)
                    has-changed?
                    (inner-loop (+ inner-idx 1)
                                (if (<<? (caddr previous-cell)
                                         (cadr previous-cell))
                                    (bubble-swap previous-cell)
                                    has-changed?)
                                (cdr previous-cell))))
              (outer-loop (- unsorted-idx 1)))))
    (cdr sentinel-l)))