From 978e8001040d71f89f77cd04dff152812348a8d7 Mon Sep 17 00:00:00 2001
From: stibear <stibear1996@gmail.com>
Date: Tue, 11 Feb 2014 06:28:36 +0900
Subject: [PATCH] implemented Searching

---
 piclib/srfi/1.scm | 107 +++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 100 insertions(+), 7 deletions(-)

diff --git a/piclib/srfi/1.scm b/piclib/srfi/1.scm
index 850f1695..a3f7f587 100644
--- a/piclib/srfi/1.scm
+++ b/piclib/srfi/1.scm
@@ -451,12 +451,9 @@
   ;; list-index
   ;; take-while drop-while take-while!
   ;; span break span! break!
-  (define (find-tail pred list)
-    (if (null? list)
-        #f
-        (if (pred (car list))
-            list
-            (find-tail pred (cdr list)))))
+
+  ;; means for inter-referential definition
+  (define find-tail #f)
 
   (define (find pred list)
     (let ((tail (find-tail pred list)))
@@ -464,7 +461,103 @@
           (car tail)
           #f)))
 
-  (export member memq memv find-tail find)
+  (define (find-tail pred list)
+    (if (null? list)
+        #f
+        (if (pred (car list))
+            list
+            (find-tail pred (cdr list)))))
+
+  (define (take-while pred clist)
+    (let rec ((clist clist) (cont values))
+      (if (null? clist)
+	  (cont '())
+	  (if (pred (car clist))
+	      (rec (cdr clist)
+		   (lambda (x) (cont (cons (car clist) x))))
+	      (cont '())))))
+
+  (define (take-while! pred clist)
+    (let rec ((clist clist))
+      (if (null? clist)
+	  '()
+	  (if (pred (car clist))
+	      (begin (set-cdr! clist (rec (cdr clist)))
+		     clist)
+	      '()))))
+
+  (define (drop-while pred clist)
+    (let rec ((clist clist))
+      (if (null? clist)
+	  '()
+	  (if (pred (car clist))
+	      (rec (cdr clist))
+	      clist))))
+
+  (define (span pred clist)
+    (values (take-while pred clist)
+	    (drop-while pred clist)))
+
+  (define (span! pred clist)
+    (values (take-while! pred clist)
+	    (drop-while! pred clist)))
+
+  (define (break pred clist)
+    (values (take-while (lambda (x) (not (pred x))) clist)
+	    (drop-while (lambda (x) (not (pred x))) clist)))
+
+  (define (break! pred clist)
+    (values (take-while! (lambda (x) (not (pred x))) clist)
+	    (drop-while! (lambda (x) (not (pred x))) clist)))
+
+  ;; means for inter-referential definition
+  (define any #f)
+  
+  (define (any pred clist . clists)
+    (if (null? clists)
+	(let rec ((clist clist))
+	  (if (pair? clist)
+	      (if (pred (car clist))
+		  #t
+		  (rec (cdr clist)))))
+	(let rec ((clists (cons clist clists)))
+	  (if (every pair? clists)
+	      (if (apply pred (map car clists))
+		  #t
+		  (rec (map cdr clists)))))))
+
+  (define (every pred clist . clists)
+    (if (null? clists)
+	(let rec ((clist clist))
+	  (if (pair? clist)
+	      (if (pred (car clist))
+		  (rec (cdr clist)))
+	      #t))
+	(let rec ((clists (cons clist clists)))
+	  (if (every pair? clists)
+	      (if (apply pred (map car clists))
+		  (rec (map cdr clists)))
+	      #t))))
+
+  (define (list-index pred clist . clists)
+    (if (null? clists)
+	(let rec ((clist clist) (n 0))
+	  (if (pair? clist)
+	      (if (pred (car clist))
+		  n
+		  (rec (cdr clist) (+ n 1)))))
+	(let rec ((clists (cons clist clists)) (n 0))
+	  (if (every pair? clists)
+	      (if (apply pred (map car clists))
+		  n
+		  (rec (map cdr clists) (+ n 1)))))))
+  
+  (export member memq memv
+	  find find-tail
+	  any every
+	  list-index
+	  take-while drop-while take-while!
+	  span break span! break!)
 
   ;; # Deleting
   ;; delete delete-duplicates