Bug in SRFI-95 sample implementation of sorted? Sudarshan S Chawathe 07 Mar 2020 21:22 UTC

There seems to be a bug in the SRFI-95 sample implementation of the
sorted?  procedure when given a vector argument with duplicates.

The sample run below illustrates the problem and suggests a simple fix
as well.  (The sorted? procedure definition is verbatim from the
sample implementation.)

I apologize for the hackish definitions of some of the dependencies,
but I don't think they change the behavior in the illustrated case. (I
had some dependency trouble getting the official SLIB installed on my
machine.)

I believe this bug also exists in the current SLIB (slib-3b6).

$ cat w.scm
(import (scheme base)
        (scheme write))

(define array? vector?)

(define array-ref vector-ref)

(define (array-dimensions arr)
  (list (vector-length arr)))

(define identity values)

(define (sorted? seq less? . opt-key)
  (define key (if (null? opt-key) identity (car opt-key)))
  (cond ((null? seq) #t)
	((array? seq)
	 (let ((dimax (+ -1 (car (array-dimensions seq)))))
	   (or (<= dimax 1)
	       (let loop ((idx (+ -1 dimax))
			  (last (key (array-ref seq dimax))))
		 (or (negative? idx)
		     (let ((nxt (key (array-ref seq idx))))
		       (and (less? nxt last)
			    (loop (+ -1 idx) nxt))))))))
	((null? (cdr seq)) #t)
	(else
	 (let loop ((last (key (car seq)))
		    (next (cdr seq)))
	   (or (null? next)
	       (let ((nxt (key (car next))))
		 (and (not (less? nxt last))
		      (loop nxt (cdr next)))))))))

(write (sorted? '(1 2 2 3) <))
(newline)
(write (sorted? #(1 2 2 3) <))
(newline)
$ chibi-scheme w.scm
#t
#f
$ diff -u w.scm w2.scm
--- w.scm	2020-03-07 16:02:00.395402293 -0500
+++ w2.scm	2020-03-07 16:02:00.395402293 -0500
@@ -20,7 +20,7 @@
 			  (last (key (array-ref seq dimax))))
 		 (or (negative? idx)
 		     (let ((nxt (key (array-ref seq idx))))
-		       (and (less? nxt last)
+		       (and (not (less? last nxt last))
 			    (loop (+ -1 idx) nxt))))))))
 	((null? (cdr seq)) #t)
 	(else
$ chibi-scheme w2.scm
#t
#t
$

Regards,

-chaw