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

From: AndrevanTonder <andre>
Date: Thu Oct 5 00:11:23 2006

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))
Received on Thu Oct 05 2006 - 00:08:38 UTC