The (aux timsort) module

Sorting and the trace buffer

Timsort

Here is a test suite for the timsort function, which implements the Timsort algorithm, a hybrid sorting algorithm derived from merge sort and insertion sort. It is designed to perform well on many kinds of real-world data. The implementation follows the specifications outlined in CPython: listobject.cCPython: listsort.txt that we extracted in Github: timsort.c and we compare it against the built-in sort function SRFI 95Wikipedia: Sorting algorithm. For the sake of completeness, we report their implementation of the sort! function, which is a wrapper around the merge! function, which merges two sorted sequences. The sort! function sorts a sequence in place using a provided comparison function less?.

(define (sort! seq less?)
  (define (step n)
    (cond ((> n 2)
           (let* ((j (quotient n 2)) (a (step j)) (k (- n j)) (b (step k)))
             (merge! a b less?)))
          ((= n 2)
           (let ((x (car seq)) (y (cadr seq)) (p seq))
             (set! seq (cddr seq))
             (if (less? y x) (begin (set-car! p y) (set-car! (cdr p) x)))
             (set-cdr! (cdr p) '())
             p))
          ((= n 1) (let ((p seq)) (set! seq (cdr seq)) (set-cdr! p '()) p))
          (else '())))
  (if (vector? seq)
    (let ((n (vector-length seq)) (vec seq))
      (set! seq (vector->list seq))
      (do ((p (step n) (cdr p)) (i 0 (+ i 1)))
          ((null? p) vec)
        (vector-set! vec i (car p))))
    (step (length seq))))
(define (merge! a b less?)
  (define (loop r a b)
    (if (less? (car b) (car a))
      (begin
        (set-cdr! r b)
        (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b))))
      (begin
        (set-cdr! r a)
        (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b)))))
  (cond ((null? a) b)
        ((null? b) a)
        ((less? (car b) (car a))
         (if (null? (cdr b)) (set-cdr! b a) (loop b a (cdr b)))
         b)
        (else (if (null? (cdr a)) (set-cdr! a b) (loop a (cdr a) b)) a)))

test/simple: pass

(define (test/simple _)
  (⊦= '(1 2 3 4 5) (timsort '(5 4 3 2 1)))
  (⊦= '(1 2 3 4 5) (timsort '(1 2 3 4 5)))
  (⊦= '(1 2 3 4 5) (timsort '(3 2 1 5 4)))
  (⊦= '(1) (timsort '(1)))
  (⊦= '() (timsort '())))
((eta 0.0) (memory #(50331648 26306464 1048576)) (stdout "") (stderr ""))

test/iota: pass

Here we test the timsort function with a large list of integers from 0 to 1000000 elements long. The list is sorted in descending order, and we expect the result to be a list sorted in ascending order.

(define (test/iota _) (⊦= r (timsort (iota n (sub1 n) -1))))
((eta 0.146) (memory #(100663296 50309296 1048576)) (stdout "") (stderr ""))

test/iota/sort: pass

(define (test/iota/sort _) (⊦= r (sort (iota n (sub1 n) -1) <)))
((eta 0.44) (memory #(201326592 50310624 1048576)) (stdout "") (stderr ""))

test/timtros/iota: pass

(define (test/timtros/iota _) (⊦= (iota n (sub1 n) -1) (timtros r)))
((eta 0.089) (memory #(201326592 74311384 1048576)) (stdout "") (stderr ""))

test/tros/iota: pass

(define (test/tros/iota _) (⊦= (iota n (sub1 n) -1) (reverse (sort r <))))
((eta 0.323) (memory #(201326592 74312816 1048576)) (stdout "") (stderr ""))

test/already-sorted: pass

(define (test/already-sorted _) (⊦= r (timsort r)))
((eta 0.068) (memory #(201326592 50313688 1048576)) (stdout "") (stderr ""))

test/already-sorted/sort: pass

(define (test/already-sorted/sort _) (⊦= r (sort r <)))
((eta 0.288) (memory #(201326592 50314984 1048576)) (stdout "") (stderr ""))

test/already-sorted/primitive: pass

(define (test/already-sorted/primitive _) (⊦= r (timsort/primitive r)))
((eta 0.063) (memory #(201326592 50316040 1048576)) (stdout "") (stderr ""))

test/primitive: pass

(define (test/primitive _)
  (⊦= (sort '(5 4 3 2 1) <) (timsort/primitive '(5 4 3 2 1)))
  (⊦= '(1.1 2.1 3.1 4.1 5.1) (timsort/primitive '(5.1 4.1 3.1 2.1 1.1)))
  (⊦= '(hello world) (timsort/primitive '(world hello))))
((eta 0.0) (memory #(201326592 50317424 1048576)) (stdout "") (stderr ""))

test/vector: pass

The vector entry points sort a vector without going through a list: timsort/vector returns a fresh vector and leaves its argument untouched, while timsort/vector! sorts in place and returns the vector it was given.

(define (test/vector _)
  (⊦= '#(1 2 3 4 5) (timsort/vector '#(5 4 3 2 1)))
  (⊦= '#(5 4 3 2 1) (timtros/vector '#(1 2 3 4 5)))
  (⊦= '#(1) (timsort/vector '#(1)))
  (⊦= '#() (timsort/vector '#()))
  (let ((v (vector 3 1 2))) (⊦= '#(1 2 3) (timsort/vector v)) (⊦= '#(3 1 2) v))
  (let ((v (vector 3 1 2)))
    (⊨ (eq? v (begin (timsort/vector! v) v)))
    (⊦= '#(1 2 3) v)))
((eta 0.0) (memory #(201326592 50319440 1048576)) (stdout "") (stderr ""))

test/vector/primitive: pass

(define (test/vector/primitive _)
  (⊦= '#("apple" "fig" "pear")
      (timsort/primitive/vector '#("pear" "apple" "fig")))
  (⊦= '#(a m z) (timsort/primitive/vector '#(z a m)))
  (⊦= '#(#\a #\b #\z) (timsort/primitive/vector '#(#\z #\b #\a)))
  (⊦= '#(#f #t) (timsort/primitive/vector '#(#t #f))))
((eta 0.0) (memory #(201326592 50320344 1048576)) (stdout "") (stderr ""))

test/key: pass

A key is applied exactly once per element rather than twice per comparison, so the ordering is decided entirely in C and the sort makes no call back into Scheme at all. A key can only express a total preorder; an arbitrary comparator still needs timsort/gen.

(define (test/key _)
  (let ((recs (list (cons 1 'a) (cons 0 'b) (cons 1 'c) (cons 0 'd))))
    (⊦= (list (cons 0 'b) (cons 0 'd) (cons 1 'a) (cons 1 'c))
        (timsort/key recs car))
    (⊦= (list (cons 1 'a) (cons 1 'c) (cons 0 'b) (cons 0 'd))
        (timtros/key recs car)))
  (let* ((seen '())
         (recs (list (cons 3 'x) (cons 1 'y) (cons 2 'z)))
         (spy (lambda (r) (set! seen (cons r seen)) (car r))))
    (timsort/key recs spy)
    (⊦= recs (reverse seen))))
((eta 0.0) (memory #(201326592 26322544 1048576)) (stdout "") (stderr ""))

test/vector/key: pass

(define (test/vector/key _)
  (let ((v (vector (cons 1 'a) (cons 0 'b) (cons 1 'c))))
    (⊦= (vector (cons 0 'b) (cons 1 'a) (cons 1 'c))
        (timsort/vector/key v car))
    (⊦= (vector (cons 1 'a) (cons 0 'b) (cons 1 'c)) v)))
((eta 0.0) (memory #(201326592 26324024 1048576)) (stdout "") (stderr ""))

test/nested-raise: pass

(define (test/nested-raise _)
  (let* ((seen '())
         (inner (timsort/gen
                  (lambda (a b) (error "boom"))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR))
         (outer (timsort/gen
                  (lambda (a b)
                    (handle-exceptions
                      e
                      (set! seen
                        (cons (get-condition-property e 'exn 'message) seen))
                      (inner '(3 1 2)))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7)))
    (⊨ (and (pair? seen) (every (lambda (m) (equal? m "boom")) seen)))
    (⊦= (length seen)
        (let ((n 0))
          ((timsort/gen
             (lambda (a b) (set! n (add1 n)) (< a b))
             #f
             #f
             #f
             #t
             TIMSORT_USE_COMPARATOR)
           '(5 2 9 1 7))
          n)))
  (let* ((count 0)
         (inner (timsort/gen
                  (lambda (a b)
                    (set! count (add1 count))
                    (if (= count 1) (abort 'once) (< a b)))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR))
         (outer (timsort/gen
                  (lambda (a b)
                    (handle-exceptions e e (inner '(3 1 2)))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7))))
  (let* ((inner (timsort/vector/gen
                  (lambda (a b) (abort 'inner))
                  #t
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR))
         (v (vector 3 1 2))
         (outer (timsort/vector/gen
                  (lambda (a b) (handle-exceptions e e (inner v)) (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '#(1 2 5 7 9) (outer (vector 5 2 9 1 7)))
    (⊦= '#(3 1 2) v))
  (let* ((inner (timsort/gen
                  (lambda (a b) (abort 'inner))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR))
         (outer (timsort/gen
                  (lambda (a b) (inner '(3 1 2)) (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= 'inner (handle-exceptions e e (outer '(5 2 9 1 7)))))
  (let* ((got '())
         (sorted '())
         (inner (timsort/gen
                  (lambda (a b)
                    (set! got (cons (raise-continuable 'c) got))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR))
         (outer (timsort/gen
                  (lambda (a b)
                    (set! sorted
                      (cons (with-exception-handler
                              (lambda (e) 'resumed)
                              (lambda () (inner '(3 1 2))))
                            sorted))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7)))
    (⊨ (and (pair? sorted) (every (lambda (l) (equal? l '(1 2 3))) sorted)))
    (⊨ (and (pair? got) (every (lambda (x) (eq? x 'resumed)) got))))
  (let* ((inner (timsort/vector/gen
                  (lambda (a b) (+ 1 (signal 'c)) (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR))
         (outer (timsort/gen
                  (lambda (a b)
                    (with-exception-handler
                      (lambda (e) 0)
                      (lambda () (inner (vector 3 1 2))))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7))))
  (let* ((seen '())
         (inner (timsort/gen
                  (lambda (a b) (raise 'x))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR))
         (outer (timsort/gen
                  (lambda (a b)
                    (set! seen
                      (cons (guard (e (#t (list 'outer e)))
                                   (guard (e ((eq? e 'never) 'no)) (inner '(3 1 2))))
                            seen))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7)))
    (⊨ (and (pair? seen) (every (lambda (x) (equal? x '(outer x))) seen))))
  (let* ((cmp (lambda (lt?)
                (timsort/gen lt? #f #f #f #t TIMSORT_USE_COMPARATOR)))
         (nested
           (lambda (thunk)
             (let ((res 'unset))
               ((cmp (lambda (a b)
                       (when (eq? res 'unset) (set! res (thunk)))
                       (< a b)))
                '(3 1 2))
               res)))
         (message
           (lambda (e)
             (if (condition? e) (get-condition-property e 'exn 'message) e)))
         (escaping
           (lambda ()
             (let ((calls 0))
               (list (call-with-current-continuation
                       (lambda (k)
                         (with-exception-handler
                           (lambda (e)
                             (set! calls (add1 calls))
                             (k (message e)))
                           (lambda ()
                             ((cmp (lambda (a b) (error "x"))) '(3 1 2))))))
                     calls))))
         (wrapping
           (lambda ()
             (let ((calls 0))
               (guard (e (#t (list e calls)))
                      (r7rs-with-exception-handler
                        (lambda (e)
                          (set! calls (add1 calls))
                          (if (> calls 5)
                            (raise 'gave-up)
                            (raise (list 'wrapped e))))
                        (lambda ()
                          ((cmp (lambda (a b) (raise 'x))) '(3 1 2))))))))
         (returning
           (lambda ()
             (guard (e (#t (list 'outer (message e))))
                    (r7rs-with-exception-handler
                      (lambda (e) 'ret)
                      (lambda ()
                        ((cmp (lambda (a b) (raise 'x))) '(3 1 2)))))))
         (expected
           (list '("x" 1)
                 '((wrapped x) 1)
                 '(outer "exception handler returned")))
         (scenarios (list escaping wrapping returning)))
    (⊦= expected (map (lambda (s) (s)) scenarios))
    (⊦= expected (map nested scenarios))
    (⊦= 'caught
        (handle-exceptions
          e
          'caught
          ((cmp (lambda (a b) (error "boom"))) '(2 1))))
    (⊦= expected (map (lambda (s) (s)) scenarios))
    (⊦= expected (map nested scenarios)))
  (let* ((msgs '())
         (outer (timsort/gen
                  (lambda (a b)
                    (set! msgs
                      (cons (handle-exceptions
                              e
                              (get-condition-property e 'exn 'message)
                              (let* ((saved #f)
                                     (l ((timsort/gen
                                           (lambda (x y)
                                             (call-with-current-continuation
                                               (lambda (k) (unless saved (set! saved k))))
                                             (< x y))
                                           #f
                                           #f
                                           #f
                                           #t
                                           TIMSORT_USE_COMPARATOR)
                                         '(3 1 2))))
                                (if (procedure? saved)
                                  (let ((k saved)) (set! saved 'done) (k #f))
                                  l)))
                            msgs))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7)))
    (⊨ (and (pair? msgs)
            (every (lambda (m)
                     (equal?
                       m
                       "a comparator was resumed after it had answered or its nested sort had failed"))
                   msgs))))
  (⊦= 0 (timsort-depth))
  (⊦= '(1 2 3) ((timsort/gen < #f #f #f #t TIMSORT_USE_COMPARATOR) '(3 1 2))))
((eta 0.001) (memory #(201326592 26333632 1048576)) (stdout "") (stderr ""))

test/nested-escape: pass

(define (test/nested-escape _)
  (let* ((got '())
         (winds '())
         (outer (timsort/gen
                  (lambda (a b)
                    (set! got
                      (cons (call-with-current-continuation
                              (lambda (k)
                                (dynamic-wind
                                  (lambda () (set! winds (cons 'in winds)))
                                  (lambda ()
                                    ((timsort/gen
                                       (lambda (x y)
                                         (dynamic-wind
                                           (lambda () (set! winds (cons 'cin winds)))
                                           (lambda () (k 'esc))
                                           (lambda () (set! winds (cons 'cout winds)))))
                                       #f
                                       #f
                                       #f
                                       #t
                                       TIMSORT_USE_COMPARATOR)
                                     '(3 1 2)))
                                  (lambda () (set! winds (cons 'out winds))))))
                            got))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7)))
    (⊨ (and (pair? got) (every (lambda (x) (eq? x 'esc)) got)))
    (⊦= (map (lambda (w) (length got)) '(in cin cout out))
        (map (lambda (w) (count (lambda (x) (eq? x w)) winds))
             '(in cin cout out))))
  (let ((outer (timsort/gen
                 (lambda (a b)
                   (call-with-current-continuation
                     (lambda (k)
                       ((timsort/gen
                          (lambda (c d)
                            ((timsort/gen
                               (lambda (e f) (k 'deep))
                               #f
                               #f
                               #f
                               #t
                               TIMSORT_USE_COMPARATOR)
                             '(3 1 2))
                            (< c d))
                          #f
                          #f
                          #f
                          #t
                          TIMSORT_USE_COMPARATOR)
                        '(9 8 7))))
                   (< a b))
                 #f
                 #f
                 #f
                 #t
                 TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7))))
  (let* ((v (vector 3 1 2))
         (outer (timsort/gen
                  (lambda (a b)
                    (call-with-current-continuation
                      (lambda (k)
                        ((timsort/vector/gen
                           (lambda (x y) (k 0))
                           #t
                           #f
                           #f
                           #t
                           TIMSORT_USE_COMPARATOR)
                         v)))
                    (< a b))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)))
    (⊦= '(1 2 5 7 9) (outer '(5 2 9 1 7)))
    (⊦= '#(3 1 2) v))
  (⊦= 'out
      (call-with-current-continuation
        (lambda (k)
          ((timsort/gen
             (lambda (a b)
               ((timsort/gen
                  (lambda (x y) (k 'out))
                  #f
                  #f
                  #f
                  #t
                  TIMSORT_USE_COMPARATOR)
                '(3 1 2))
               (< a b))
             #f
             #f
             #f
             #t
             TIMSORT_USE_COMPARATOR)
           '(5 2 9 1 7)))))
  (⊦= 0 (timsort-depth))
  (⊦= '(1 2 3) ((timsort/gen < #f #f #f #t TIMSORT_USE_COMPARATOR) '(3 1 2))))
((eta 0.0) (memory #(201326592 26335400 1048576)) (stdout "") (stderr ""))

The trace buffer

The call-chain buffer is scanned in full by the minor collection that ends every re-entry into Scheme from C, so its length multiplies the cost of every comparison a Scheme comparator makes. timsort-trace-buffer-size shrinks it for the extent of a sort. It is off by default, because the resize also clears the recorded call chain and so shortens the backtrace of anything the comparator raises.

These tests are about the parameter, not about the ordering: the sorted results themselves are checked in timsort.scm.

test/default-is-off: pass

(define (test/default-is-off _)
  (⊦= #f (timsort-trace-buffer-size))
  (⊦= default-size (timsort-trace-buffer-size/current))
  (timsort/comparator records)
  (⊦= default-size (timsort-trace-buffer-size/current)))
((eta 0.024) (memory #(12582912 2230016 1048576)) (stdout "") (stderr ""))

test/size-is-restored-exactly: pass

(define (test/size-is-restored-exactly _)
  (parameterize
    ((timsort-trace-buffer-size 3))
    (do ((i 0 (+ i 1)))
        ((= i 200))
      (timsort/comparator (list (cons 3 'a) (cons 1 'b) (cons 2 'c)))))
  (⊦= default-size (timsort-trace-buffer-size/current)))
((eta 0.001) (memory #(12582912 2231760 1048576)) (stdout "") (stderr ""))

test/restored-on-every-exit: pass

(define (test/restored-on-every-exit _)
  (parameterize
    ((timsort-trace-buffer-size 3))
    (timsort/comparator records)
    (⊦= default-size (timsort-trace-buffer-size/current))
    (handle-exceptions
      e
      #t
      ((timsort/gen
         (lambda (a b) (error 'boom "from the comparator"))
         #f
         #f
         #f
         #t
         TIMSORT_USE_COMPARATOR)
       records))
    (⊦= default-size (timsort-trace-buffer-size/current))
    (call-with-current-continuation
      (lambda (k)
        ((timsort/gen
           (lambda (a b) (k 'escaped))
           #f
           #f
           #f
           #t
           TIMSORT_USE_COMPARATOR)
         records)))
    (⊦= default-size (timsort-trace-buffer-size/current)))
  (⊦= default-size (timsort-trace-buffer-size/current)))
((eta 0.013) (memory #(12582912 2339696 1048576)) (stdout "") (stderr ""))

test/comparator-runs-under-the-requested-size: pass

(define (test/comparator-runs-under-the-requested-size _)
  (let ((seen '()))
    (parameterize
      ((timsort-trace-buffer-size 3))
      ((timsort/gen
         (lambda (a b)
           (set! seen (cons (timsort-trace-buffer-size/current) seen))
           (< a b))
         #f
         #f
         #f
         #t
         TIMSORT_USE_COMPARATOR)
       '(5 4 3 2 1 9 7 8)))
    (⊦= '(3) (delete-duplicates seen)))
  (let ((seen '()))
    ((timsort/gen
       (lambda (a b)
         (set! seen (cons (timsort-trace-buffer-size/current) seen))
         (< a b))
       #f
       #f
       #f
       #t
       TIMSORT_USE_COMPARATOR)
     '(5 4 3 2 1 9 7 8))
    (⊦= (list default-size) (delete-duplicates seen))))
((eta 0.0) (memory #(12582912 2341928 1048576)) (stdout "") (stderr ""))

test/nesting-restores-per-level: pass

(define (test/nesting-restores-per-level _)
  (let ((inside-after-inner #f) (done #f))
    (parameterize
      ((timsort-trace-buffer-size 8))
      ((timsort/gen
         (lambda (a b)
           (unless
             done
             (set! done #t)
             (parameterize
               ((timsort-trace-buffer-size 3))
               ((timsort/gen < #f #f #f #t TIMSORT_USE_COMPARATOR) '(3 1 2)))
             (set! inside-after-inner (timsort-trace-buffer-size/current)))
           (< a b))
         #f
         #f
         #f
         #t
         TIMSORT_USE_COMPARATOR)
       '(5 4 3 2 1)))
    (⊦= 8 inside-after-inner)
    (⊦= default-size (timsort-trace-buffer-size/current))))
((eta 0.0) (memory #(12582912 2342472 1048576)) (stdout "") (stderr ""))

test/with-form: pass

(define (test/with-form _)
  (⊦= (list 3 '(1 2 3))
      (with-timsort-trace-buffer-size
        3
        (lambda ()
          (list (timsort-trace-buffer-size/current) (timsort '(3 1 2))))))
  (⊦= default-size (timsort-trace-buffer-size/current))
  (handle-exceptions
    e
    #t
    (with-timsort-trace-buffer-size 3 (lambda () (error 'boom "inside"))))
  (⊦= default-size (timsort-trace-buffer-size/current))
  (⊦= default-size
      (with-timsort-trace-buffer-size
        #f
        (lambda () (timsort-trace-buffer-size/current)))))
((eta 0.0) (memory #(12582912 2343424 1048576)) (stdout "") (stderr ""))

test/rejects-values-C-cannot-use: pass

(define (test/rejects-values-C-cannot-use _)
  (let ((expected
          "expected #f, or a fixnum between the runtime's minimum and 65536"))
    (⊦= expected
        (message-of
          (lambda () (parameterize ((timsort-trace-buffer-size 16.0)) #t))))
    (⊦= expected
        (message-of
          (lambda () (parameterize ((timsort-trace-buffer-size 2)) #t))))
    (⊦= expected
        (message-of
          (lambda () (parameterize ((timsort-trace-buffer-size 'small)) #t))))
    (⊦= expected
        (message-of
          (lambda ()
            (parameterize ((timsort-trace-buffer-size (expt 2 80))) #t))))
    (⊦= expected
        (message-of
          (lambda () (parameterize ((timsort-trace-buffer-size 65537)) #t))))
    (⊨ (fixnum?
         (parameterize
           ((timsort-trace-buffer-size 65536))
           (timsort-trace-buffer-size)))))
  (⊦= 3
      (parameterize
        ((timsort-trace-buffer-size 3))
        (timsort-trace-buffer-size)))
  (⊦= default-size (timsort-trace-buffer-size/current)))
((eta 0.0) (memory #(12582912 2345752 1048576)) (stdout "") (stderr ""))

test/results-identical-with-the-knob-on: pass

(define (test/results-identical-with-the-knob-on _)
  (let ((reference (sort records key<?)))
    (⊨ (every eq? reference (timsort/comparator records)))
    (⊨ (every eq?
              reference
              (parameterize
                ((timsort-trace-buffer-size 3))
                (timsort/comparator records)))))
  (let ((reference (reverse (sort (reverse records) key<?))))
    (⊨ (every eq?
              reference
              (parameterize
                ((timsort-trace-buffer-size 3))
                (timtros/comparator records))))))
((eta 0.06) (memory #(12582912 2338200 1048576)) (stdout "") (stderr ""))

test/C-evaluated-families-unaffected: pass

(define (test/C-evaluated-families-unaffected _)
  (let ((d (list-tabulate 2000 (lambda (i) (modulo (* i 40503) 1000)))))
    (parameterize
      ((timsort-trace-buffer-size 3))
      (⊦= (sort d <) (timsort d))
      (⊦= (reverse (sort (reverse d) <)) (timtros d))
      (⊦= (sort d <) (timsort/primitive d))
      (let ((c (list-copy d))) (timsort! c) (⊦= (sort d <) c))
      (⊦= '("a" "b" "c") (timsort/primitive '("b" "a" "c")))
      (⊦= "bad argument type - not a number"
          (message-of (lambda () (timsort (list 1 "two" 3))))))))
((eta 0.003) (memory #(12582912 2390832 1048576)) (stdout "") (stderr ""))
Categories: scheme 

See also

The (aux anthropic) module The Anthropic Messages API, offline The (aux cml) module Events, threads, synchronous variables, the library and I/O The (aux hakaru10) modules Random sources, distributions, the language, exact inference and examples The (aux kanren) modules Arithmetic, dates, presentation of answers and a union-find miniKanren The (aux games dice-of-doom) module Dice of Doom The (aux machine) modules Environments, the SC machine and the SECD machine The (aux schemer seasoned) module The Seasoned Schemer The (aux continuation) modules Classic operators, escapers, amb and Collatz sequences The (aux category) modules Monads: list, maybe, probability, ziplist, difference lists and state The (aux fds) modules Functional queues and union-find The (aux sxml) module Rendering SXML to HTML The (aux variable) module Logic variables introduced by fresh The (aux tabling) module Memoization and tabled definitions The (aux commons) module Learning tests for CHICKEN Scheme Promises delay and make-promise The Ackermann function On unary numbers, as lists Concurrent ML for CHICKEN Scheme Porting SML/NJ CML as the (aux cml) library CHICKEN Scheme Versions and implementation notes The SBRAL data structure Skew Binary Random-Access Lists Pattern matching Scheme macrology: a generalized pattern matcher The (aux hansei) modules Inference, random sources, lazy lists, logic programming and example models The (aux nondeterministic) module Learning tests for Scheme The (aux stream) modules Streams, streams after SICP, and sequences and power series The (aux unittest) module Bootstrapping a unittest framework Scheme lang: Chez, 48 and Chicken Some docs, refs and containers, respectively. The Reasoned Schemer miniKanren, microKanren and some implementations Aggregation predicates for µkanren Groups, window functions, sets and enumerations miniKanren, live and untagged Quine generation via relational interpreters Pure, declarative, and constructive arithmetic relations A declarative pearl Final shift for call/cc Direct implementation of shift and reset Call with Current Continuation Patterns Cogen in six lines The Seasoned Schemer The Little Schemer Adding generic functions to Scheme Handling control
Table of Contents