changing SRFI-1 any to return the result of the pred

was previously returning the args as in find (thanks kiyokap)

lib/chibi/optimize/rest.scm

@@ -19,17 +19,17 @@
    (lambda (p a)
      (match a
        (((? (lambda (op) (eq? op cdr))) ($ Ref name (_ . (? lambda? lam))))
-        (let ((x (any (lambda (r)
+        (let ((x (find (lambda (r)
-                        (and (eq? name (car r)) (eq? lam (cadr r))))
+                         (and (eq? name (car r)) (eq? lam (cadr r))))
-                      cdrs)))
+                       cdrs)))
           (and x (list p f (+ (caddr x) 1)))))
        (($ Cnd
            ((? (lambda (op) (eq? op pair?))) ($ Ref name (_ . (? lambda? lam))))
            ((? (lambda (op) (eq? op cdr))) ($ Ref name (_ . (? lambda? lam))))
            (or () ($ Lit ())))
-        (let ((x (any (lambda (r)
+        (let ((x (find (lambda (r)
-                        (and (eq? name (car r)) (eq? lam (cadr r))))
+                         (and (eq? name (car r)) (eq? lam (cadr r))))
-                      cdrs)))
+                       cdrs)))
           (and x (list p f (+ (caddr x) 1.0)))))
        (else #f)))
    params
@@ -80,8 +80,8 @@
          (and ls (make-seq ls))))
       (((? opcode? op) ($ Ref name (_ . (? lambda? f))))
        (let ((r (and (memq op safe-primitives)
-                     (any (lambda (r) (and (eq? name (car r)) (eq? f (cadr r))))
+                     (find (lambda (r) (and (eq? name (car r)) (eq? f (cadr r))))
-                          cdrs))))
+                           cdrs))))
          (cond
           ((not r)
            x)

lib/init.scm

@@ -91,26 +91,25 @@
 
 (define (any pred ls . lol)
   (define (any1 pred ls)
-    (if (pair? ls) (if (pred (car ls)) (car ls) (any1 pred (cdr ls))) #f))
+    (if (null? (cdr ls))
+        (pred (car ls))
+        ((lambda (x) (if x x (any1 pred (cdr ls)))) (pred (car ls)))))
   (define (anyn pred lol)
     (if (every pair? lol)
-        ((lambda (args) (if (apply pred args) args (anyn pred (map cdr lol))))
+        ((lambda (x) (if x x (anyn pred (map cdr lol))))
-         (map car lol))
+         (apply pred (map car lol)))
         #f))
-  (if (null? lol) (any1 pred ls) (anyn pred (cons ls lol))))
+  (if (null? lol) (if (null? ls) #f (any1 pred ls)) (anyn pred (cons ls lol))))
 
 (define (every pred ls . lol)
   (define (every1 pred ls)
-    (if (pair? ls) (if (pred (car ls)) (every1 pred (cdr ls)) #f) #t))
+    (if (null? (cdr ls))
+        (pred (car ls))
+        (if (pred (car ls)) (every1 pred (cdr ls)) #f)))
   (if (null? lol)
-      (every1 pred ls)
+      (if (null? ls) #t (every1 pred ls))
       (not (apply any (lambda (x) (not (pred x))) ls lol))))
 
-(define (delq x ls)
-  (if (pair? ls)
-      (if (eq? x (car ls)) (delq x (cdr ls)) (cons (car ls) (delq x (cdr ls))))
-      '()))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; syntax
 
@@ -408,6 +407,12 @@
 
 (define assv assoc)
 
+(define (find-tail pred ls)
+  (and (pair? ls) (if (pred (car ls)) ls (find-tail pred (cdr ls)))))
+
+(define (find pred ls)
+  (cond ((find-tail pred ls) => car) (else #f)))
+
 ;; math utils
 
 (define (number? x) (if (fixnum? x) #t (if (bignum? x) #t (flonum? x))))
@@ -771,7 +776,7 @@
            (cond
             ((identifier? t)
              (cond
-              ((any (lambda (v) (compare t (car v))) vars)
+              ((find (lambda (v) (compare t (car v))) vars)
                => (lambda (cell)
                     (if (<= (cdr cell) dim)
                         t

lib/srfi/1/search.scm

@@ -2,12 +2,6 @@
 ;; Copyright (c) 2009-2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
-(define (find pred ls)
-  (cond ((find-tail pred ls) => car) (else #f)))
-
-(define (find-tail pred ls)
-  (and (pair? ls) (if (pred (car ls)) ls (find-tail pred (cdr ls)))))
-
 (define (take-while pred ls)
   (let lp ((ls ls) (res '()))
     (if (and (pair? ls) (pred (car ls)))

tools/chibi-doc

@@ -406,7 +406,7 @@ div#footer {padding-bottom: 50px}
 (define (section>=? x n)
   (and (pair? x)
        (if (memq (car x) '(div))
-           (any (lambda (y) (section>=? y n)) (sxml-body x))
+           (find (lambda (y) (section>=? y n)) (sxml-body x))
            (>= (section-number (car x)) n))))
 
 (define (extract-sxml tag x)

tools/chibi-ffi

@@ -744,11 +744,11 @@
    ((and (not (type-default? arg)) (type-value arg))
     => (lambda (x)
          (cond
-          ((any (lambda (y)
+          ((find (lambda (y)
-                  (and (type-array y)
+                   (and (type-array y)
-                       (type-auto-expand? y)
+                        (type-auto-expand? y)
-                       (eq? x (get-array-length func y))))
+                        (eq? x (get-array-length func y))))
-                (func-c-args func))
+                 (func-c-args func))
            => (lambda (y) (cat "len" (type-index y))))
           (else (write x)))))
    ((or (type-result? arg) (type-array arg))
@@ -785,7 +785,7 @@
         c-args)
        (cat ")"))
      (cond
-      ((any type-link? (func-c-args func))
+      ((find type-link? (func-c-args func))
        => (lambda (a) (string-append "arg" (type-index-string a))))
       (else #f)))
     (cat ";\n")
@@ -842,7 +842,7 @@
                  "")
              "err) {\n"
              (cond
-              ((any type-auto-expand? (func-c-args func))
+              ((find type-auto-expand? (func-c-args func))
                => (lambda (a)
                     (lambda ()
                       (let ((len (get-array-length func a))
@@ -1100,8 +1100,8 @@
                        ((pair? ls)
                         (let* ((a (car ls))
                                (field
-                                (any (lambda (f) (and (pair? f) (eq? a (cadr f))))
+                                (find (lambda (f) (and (pair? f) (eq? a (cadr f))))
-                                     (cddr x))))
+                                      (cddr x))))
                           (if field
                               (cat "  r->" (cadr field) " = "
                                    (lambda ()