From 1ba5df1fdf53c39060aa63c68a3ef90c985ff5b2 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 2 Apr 2023 22:48:51 +0900 Subject: [PATCH] =?UTF-8?q?Adding=20missing=20length<=3D=3F=20(closes=20#9?= =?UTF-8?q?09).?= --- lib/scheme/rlist.sld | 1 + lib/srfi/101.scm | 7 +++++++ lib/srfi/101.sld | 1 + lib/srfi/101/test.sld | 4 ++++ 4 files changed, 13 insertions(+) diff --git a/lib/scheme/rlist.sld b/lib/scheme/rlist.sld index 60107047..6da895a2 100644 --- a/lib/scheme/rlist.sld +++ b/lib/scheme/rlist.sld @@ -39,6 +39,7 @@ (rename list rlist) (rename make-list make-rlist) (rename length rlength) + (rename length<=? rlength<=?) (rename append rappend) (rename reverse rreverse) (rename list-tail rlist-tail) diff --git a/lib/srfi/101.scm b/lib/srfi/101.scm index 34740387..2b808243 100644 --- a/lib/srfi/101.scm +++ b/lib/srfi/101.scm @@ -338,6 +338,13 @@ (+ (kons-size ls) (recr (kons-rest ls))) 0))) +(define (ra:length<=? ls k) + (let lp ((ls ls) (k k)) + (if (positive? k) + (and (ra:pair? ls) + (lp (ra:cdr ls) (- k 1))) + #t))) + (define (make-foldl empty? first rest) (letrec ((f (lambda (cons empty ls) (if (empty? ls) diff --git a/lib/srfi/101.sld b/lib/srfi/101.sld index daef1b8a..b91f0906 100644 --- a/lib/srfi/101.sld +++ b/lib/srfi/101.sld @@ -44,6 +44,7 @@ (rename ra:list list) (rename ra:make-list make-list) (rename ra:length length) + (rename ra:length<=? length<=?) (rename ra:append append) (rename ra:reverse reverse) (rename ra:list-tail list-tail) diff --git a/lib/srfi/101/test.sld b/lib/srfi/101/test.sld index c96af0b6..ea7b597f 100644 --- a/lib/srfi/101/test.sld +++ b/lib/srfi/101/test.sld @@ -79,6 +79,10 @@ (test 3 (length (list 'a 'b 'c))) (test 3 (length (list 'a (list 'b) (list 'c)))) (test 0 (length '())) + (test #t (length<=? 'not-a-list 0)) + (test #t (length<=? '(a . b) 0)) + (test #t (length<=? '(a . b) 1)) + (test #f (length<=? '(a . b) 2)) ;; append (test (list 'x 'y) (append (list 'x) (list 'y)))