From 7791e718f9cf7205c37f845d7e67e80bbd4766c5 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Wed, 24 Feb 2010 17:53:59 -0800 Subject: [PATCH] =?utf8?q?Add=20length=3D=3F=20procedure.?= --- src/runtime/list.scm | 28 ++++++++++++++++++++++++++++ src/runtime/runtime.pkg | 1 + 2 files changed, 29 insertions(+) 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 -- 2.25.1