[r6rs-discuss] [Formal] Requirement to detect circular lists - benchmarks

[AndrevanTonder]

On Wed, 4 Oct 2006, Shiro Kawai wrote:

> I used to think one advantage of current requirement
> was that 'map' and alike could check argument vailidity along
> applying the passed procedure on elements, so it could avoid
> two-pass check cost, but Mr. Clinger has explained it's not the case.

To have some point of comparison, I have done just two simple
non-represntative benchmarks comparing r5rs and r6rs versions of map (1-arg). 
The r6rs version does the circularity check up front (implementations that do 
the check concurrently will presumably take longer on a single processor given 
the additional thread overhead).  The listing with the specific tests is at the end.

All was done best of 5 with default compiler options on Pentium 4.

                        r5rs map    r6rs map    %
                        --------    --------    -
Larceny                  703         953      136%
Petite (interpr)        3078        6766      220%

These are the best results.  On Larceny some of the individual results 
were the other way around.  I would be curious to know what the Chez compiler 
does with this.

Cheers
Andre

(define (list-circ? clist)
   (define (test hare tortoise)
     (or (null? hare)
         (and (pair? hare)
              (let ((hare (cdr hare)))
                (or (null? hare)
                    (and (pair? hare)
                         (not (eq? hare tortoise))
                         (test (cdr hare) (cdr tortoise))))))))
   (test clist clist))

(define (map-circ f clist)
   (define (map-1 list)
     (if (null? list)
         '()
         (cons (f (car list))
               (map-1 (cdr list)))))
   (or (list-circ? clist)
       (error "Not a list"))
   (map-1 clist))

(define (map-reg f list)
   (define (map-1 list)
     (cond ((null? list) '())
           ((pair? list)
            (cons (f (car list))
                  (map-1 (cdr list))))
           (else (error "Not a list"))))
   (map-1 list))

(define (create n)
   (if (= n 0)
       '()
       (cons (list #t) (create (- n 1)))))

(define (test m ls fun)
   (define (test-one p)
     (let f ((m m))
       (if (not (= m 0))
           (begin (p car ls)
                  (f (- m 1))))))
   (test-one fun))

;; do create outide anyway

(define l1 (create 1000000))
(define l2 (create 10000))
(define l3 (create 100))
(define l4 (create 1))

(define (test* f)
   (test 1 l1 f)
   (test 100 l2 f)
   (test 10000 l3 f)
   (test 1000000 l4 f)
   #t)

(time (test* map-reg))
(time (test* map-circ))