A simple program to measure list accumulation performance

accum.ss

(import :std/srfi/1
        :std/misc/list
        :gerbil/gambit/os)
(export main)

(def (accum1 lst)
  (let lp ((rest lst) (r []))
    (match rest
      ([e . rest]
       (lp rest (cons e r)))
      (else
       (reverse! r)))))

(def (accum2 lst)
  (let (root [#f])
    (let lp ((rest lst) (tl root))
      (match rest
        ([e . rest]
         (let (tl* [e])
           (set! (cdr tl) tl*)
           (lp rest tl*)))
        (else
         (cdr root))))))

(def (accum3 lst)
  (with-list-builder (push)
    (let lp ((rest lst))
      (match rest
        ([e . rest]
         (push e)
         (lp rest))
        (else (void))))))

(def (main n)
  (let* ((N (string->number n))
         (lst (iota N)))
    (##gc)
    (time (accum1 lst))
    (##gc)
    (time (accum2 lst))
    (##gc)
    (time (accum3 lst))))

Variant to run only one variant at once, at which point the discrepancy between 3 and 6 becomes noise instead of being 4.5x. On the other hand, accum6 becomes 1 to 5% slower than accum2 instead of 2x faster. Whatever that means...

;;#!/usr/bin/env gxi
;;; https://gitter.im/gerbil-scheme/community?at=5eda5ea7225dc25f54ca68d4
;;; https://gist.github.com/vyzo/3db10df3a1fd886bbda5d57369455ff6

;;; gxc -O -exe -o accum accum.ss && for i in 1 2 3 4 5 6 ; do ./accum $i 100000000 ; done

(import :std/srfi/1
        :std/misc/list
        :gerbil/gambit/os)
(export main)

(def (call-with-list-builder1 fun)
  (let* ((head (cons #f '())) ;; use a traditional implementation of queue as cons of tail and head
         (poke (lambda (val)
                 (let ((old-tail (car head))
                       (new-tail (cons val '())))
                   (set-cdr! old-tail new-tail)
                   (set-car! head new-tail))))
         (peek (lambda () (cdr head))))
    (set-car! head head)
    (fun poke peek)
    (peek)))

(defrules with-list-builder1 ()
  ((_ (c r) body1 body+ ...) (call-with-list-builder1 (lambda (c r) body1 body+ ...)))
  ((_ (c) body1 body+ ...) (with-list-builder1 (c _) body1 body+ ...)))

(defrules with-list-builder2 ()
  ((_ (c) body1 body+ ...) (with-list-builder2 (c _) body1 body+ ...))
  ((_ (poke peek) body1 body+ ...)
   (let* ((head (cons #f '()))) ;; use a traditional implementation of queue as cons of tail and head
     (set-car! head head)
     (defrules poke ()
       ((_ val) (let ((new-tail (cons val '()))
                      (old-tail (car head)))
                  (set-cdr! old-tail new-tail)
                  (set-car! head new-tail)))
       ((_ . _) (error "invalid number of arguments" poke))
       (_ (lambda (val) (poke val))))
     (defrules peek ()
       ((_) (cdr head))
       ((_ . _) (error "invalid number of arguments" peek))
       (_ (lambda () (peek))))
     body1 body+ ... (peek))))

(def (call-with-list-builder2 fun)
  (with-list-builder2 (poke peek) (fun poke peek)))

(defrules with-list-builder3 ()
  ((_ (c) body1 body+ ...) (with-list-builder3 (c _) body1 body+ ...))
  ((_ (poke peek) body1 body+ ...)
   (let* ((head (cons #f '())) ;; use a traditional implementation of queue as cons of tail and head
          (tail head))
     (defrules poke ()
       ((_ val) (let ((new-tail (cons val '())))
                  (set-cdr! tail new-tail)
                  (set! tail new-tail)))
       ((_ . _) (error "invalid number of arguments" poke))
       (_ (lambda (val) (poke val))))
     (defrules peek ()
       ((_) (cdr head))
       ((_ . _) (error "invalid number of arguments" peek))
       (_ (lambda () (peek))))
     body1 body+ ... (peek))))

(def (call-with-list-builder3 fun)
  (with-list-builder3 (poke peek) (fun poke peek)))

(def (accum1 lst)
  (let lp ((rest lst) (r []))
    (match rest
      ([e . rest]
       (lp rest (cons e r)))
      (else
       (reverse! r)))))

(def (accum2 lst)
  (let (root [#f])
    (let lp ((rest lst) (tl root))
      (match rest
        ([e . rest]
         (let (tl* [e])
           (set! (cdr tl) tl*)
           (lp rest tl*)))
        (else
         (cdr root))))))

(def (accum3 lst)
  (with-list-builder (push)
    (let lp ((rest lst))
      (match rest
        ([e . rest]
         (push e)
         (lp rest))
        (else (void))))))

(def (accum4 lst)
  (with-list-builder1 (push)
    (let lp ((rest lst))
      (match rest
        ([e . rest]
         (push e)
         (lp rest))
        (else (void))))))

(def (accum5 lst)
  (with-list-builder2 (push)
    (let lp ((rest lst))
      (match rest
        ([e . rest]
         (push e)
         (lp rest))
        (else (void))))))

(def (accum6 lst)
  (with-list-builder3 (push)
    (let lp ((rest lst))
      (match rest
        ([e . rest]
         (push e)
         (lp rest))
        (else (void))))))

(def accums (vector accum1 accum2 accum3 accum4 accum5 accum6))

(def (main m n)
  (let* ((N (string->number n))
         (lst (iota N))
         (M (string->number m))
         (accum (vector-ref accums (1- M))))
    (##gc)
    (time (accum lst))))

It seems we had some very weird cpu caching effects; also gc minor faults!
I think the separate test restores sanity.