Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-07 05:06:37 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

moving generalized every/any from srfi-1 to init

Browse source
This commit is contained in:
Alex Shinn 2011-05-18 01:03:16 -07:00
parent 2b86320652
commit 24631a8cf2
2 changed files with 16 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
lib/init.scm
View file

@ -89,11 +89,22 @@
(define (for1 f ls) (if (pair? ls) (begin (f (car ls)) (for1 f (cdr ls)))))
(if (null? lol) (for1 f ls) (begin (apply map f ls lol) (if #f #f))))
(define (any pred ls)
(if (pair? ls) (if (pred (car ls)) (car ls) (any pred (cdr ls))) #f))
(define (any pred ls . lol)
(define (any1 pred ls)
(if (pair? ls) (if (pred (car ls)) (car ls) (any1 pred (cdr ls))) #f))
(define (anyn pred lol)
(if (every pair? lol)
((lambda (args) (if (apply pred args) args (anyn pred (map cdr lol))))
(map car lol))
#f))
(if (null? lol) (any1 pred ls) (anyn pred (cons ls lol))))
(define (every pred ls)
(if (pair? ls) (if (pred (car ls)) (every pred (cdr ls)) #f) #t))
(define (every pred ls . lol)
(define (every1 pred ls)
(if (pair? ls) (if (pred (car ls)) (every1 pred (cdr ls)) #f) #t))
(if (null? lol)
(every1 pred ls)
(not (apply any (lambda (x) (not (pred x))) ls lol))))
(define (delq x ls)
(if (pair? ls)

15
lib/srfi/1/search.scm
View file

@ -1,5 +1,5 @@
;; search.scm -- list searching and splitting
;; Copyright (c) 2009 Alex Shinn. All rights reserved.
;; Copyright (c) 2009-2011 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
(define (find pred ls)
@ -31,19 +31,6 @@
(define break! break)
(define (any pred ls . lists)
(if (null? lists)
(let lp ((ls ls)) (and (pair? ls) (if (pred (car ls)) (car ls) (lp (cdr ls)))))
(let lp ((lists (cons ls lists)))
(and (every pair? lists)
(let ((args (map car lists)))
(if (apply pred args) args (lp (map cdr lists))))))))
(define (every pred ls . lists)
(if (null? lists)
(let lp ((ls ls)) (if (pair? ls) (and (pred (car ls)) (lp (cdr ls))) #t))
(not (apply any (lambda (x) (not (pred x))) ls lists))))
(define (list-index pred ls . lists)
(if (null? lists)
(let lp ((ls ls) (n 0))