From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Thu, 25 Feb 2010 01:53:59 +0000 (-0800)
Subject: Add length=? procedure.
X-Git-Tag: 20100708-Gtk~150
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7791e718f9cf7205c37f845d7e67e80bbd4766c5;p=mit-scheme.git

Add length=? procedure.
---

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index 7af702cc8..8f0aa1c6c 100644
--- a/src/runtime/list.scm
+++ b/src/runtime/list.scm
@@ -240,6 +240,34 @@ USA.
 (define (length list)
   (guarantee-list->length list 'LENGTH))
 
+(define (length=? left right)
+  (define (%length=? n list)
+    (cond ((pair? list) (and (fix:positive? n)
+			     (%length=? (fix:- n 1) (cdr list))))
+	  ((null? list) (fix:zero? n))
+	  (else (error:not-list list 'length=?))))
+
+  (define (%same-length left right)
+    (cond ((pair? left) (cond ((pair? right) (%same-length (cdr left) (cdr right)))
+			      ((null? right) #f)
+			      (else (error:not-list right 'length=?))))
+	  ((null? left) (cond ((pair? right) #f)
+			      ((null? right) #t)
+			      (else (error:not-list right 'length=?))))
+	  (else (error:not-list left 'length=?))))
+
+  ;; Take arguments in either order to make this easy to use.
+  (cond ((pair? left) (cond ((pair? right) (%same-length (cdr left) (cdr right)))
+			    ((index-fixnum? right) (%length=? right left))
+			    ((null? right) #F)
+			    (else (error:wrong-type-argument right "index fixnum or list" 'length=?))))
+	((index-fixnum? left) (%length=? left right))
+	((null? left) (cond ((pair? right) #f)
+			    ((index-fixnum? right) (fix:zero? right))
+			    ((null right) #t)
+			    (else (error:wrong-type-argument right "index fixnum or list" 'length=?))))
+	(else (error:wrong-type-argument left "index fixnum or list" 'length=?))))
+
 (define (not-pair? x)
   (not (pair? x)))
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 11ec4db50..ea4a25717 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2359,6 +2359,7 @@ USA.
 	  last				;SRFI-1
 	  last-pair
 	  length
+	  length=?
 	  list
 	  list->weak-list
 	  list-copy