mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
Adding missing length<=? (closes #909).
This commit is contained in:
parent
7e511ef8e4
commit
1ba5df1fdf
4 changed files with 13 additions and 0 deletions
|
@ -39,6 +39,7 @@
|
||||||
(rename list rlist)
|
(rename list rlist)
|
||||||
(rename make-list make-rlist)
|
(rename make-list make-rlist)
|
||||||
(rename length rlength)
|
(rename length rlength)
|
||||||
|
(rename length<=? rlength<=?)
|
||||||
(rename append rappend)
|
(rename append rappend)
|
||||||
(rename reverse rreverse)
|
(rename reverse rreverse)
|
||||||
(rename list-tail rlist-tail)
|
(rename list-tail rlist-tail)
|
||||||
|
|
|
@ -338,6 +338,13 @@
|
||||||
(+ (kons-size ls) (recr (kons-rest ls)))
|
(+ (kons-size ls) (recr (kons-rest ls)))
|
||||||
0)))
|
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)
|
(define (make-foldl empty? first rest)
|
||||||
(letrec ((f (lambda (cons empty ls)
|
(letrec ((f (lambda (cons empty ls)
|
||||||
(if (empty? ls)
|
(if (empty? ls)
|
||||||
|
|
|
@ -44,6 +44,7 @@
|
||||||
(rename ra:list list)
|
(rename ra:list list)
|
||||||
(rename ra:make-list make-list)
|
(rename ra:make-list make-list)
|
||||||
(rename ra:length length)
|
(rename ra:length length)
|
||||||
|
(rename ra:length<=? length<=?)
|
||||||
(rename ra:append append)
|
(rename ra:append append)
|
||||||
(rename ra:reverse reverse)
|
(rename ra:reverse reverse)
|
||||||
(rename ra:list-tail list-tail)
|
(rename ra:list-tail list-tail)
|
||||||
|
|
|
@ -79,6 +79,10 @@
|
||||||
(test 3 (length (list 'a 'b 'c)))
|
(test 3 (length (list 'a 'b 'c)))
|
||||||
(test 3 (length (list 'a (list 'b) (list 'c))))
|
(test 3 (length (list 'a (list 'b) (list 'c))))
|
||||||
(test 0 (length '()))
|
(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
|
;; append
|
||||||
(test (list 'x 'y) (append (list 'x) (list 'y)))
|
(test (list 'x 'y) (append (list 'x) (list 'y)))
|
||||||
|
|
Loading…
Add table
Reference in a new issue