[uim-commit] r142 - in trunk: scm test

[yamaken@freedesktop.org]

Author: yamaken
Date: 2005-01-06 04:26:36 -0800 (Thu, 06 Jan 2005)
New Revision: 142

Modified:
   trunk/scm/plugin.scm
   trunk/scm/util.scm
   trunk/test/test-util.scm
Log:
* scm/util.scm
  - (iterate-lists):
    * Replace map with mapcar to implement map
    * Remove recursion invocation redundancy
  - (map): Support 4 or more lists as argument by new implementation
    using iterate-lists. Use native mapcar when the lists is up to
    3. Thanks TOKUNAGA Hiroyuki for fast mapcar3 implementation
  - (for-each): Replace mapcar with map to support arbitrary length of
    list arguments
* test/test-util.scm
  - (test map): Add 2 cases for 3 and 4 lists of argument

* scm/plugin.scm
  - Comment out print debug form to run testing framework


Modified: trunk/scm/plugin.scm
===================================================================
--- trunk/scm/plugin.scm	2005-01-06 11:10:34 UTC (rev 141)
+++ trunk/scm/plugin.scm	2005-01-06 12:26:36 UTC (rev 142)
@@ -54,5 +54,6 @@
 	  (append uim-plugin-lib-load-path
 		  (string-split (getenv "LD_LIBRARY_PATH") ":"))))
 
-(print uim-plugin-lib-load-path)
-(print uim-plugin-scm-load-path)
+;; 'print' prevents testing framework from normal run.
+;;(print uim-plugin-lib-load-path)
+;;(print uim-plugin-scm-load-path)

Modified: trunk/scm/util.scm
===================================================================
--- trunk/scm/util.scm	2005-01-06 11:10:34 UTC (rev 141)
+++ trunk/scm/util.scm	2005-01-06 12:26:36 UTC (rev 142)
@@ -121,17 +121,17 @@
 ;; local procedure. don't use in outside of util.scm
 (define iterate-lists
   (lambda (mapper state lists)
-    (let ((runs-out? (apply proc-or (map null? lists))))
+    (let ((runs-out? (apply proc-or (mapcar null? lists))))
       (if runs-out?
 	  (cdr (mapper state ()))
-	  (let* ((elms (map car lists))
-		 (rests (map cdr lists))
+	  (let* ((elms (mapcar car lists))
+		 (rests (mapcar cdr lists))
 		 (pair (mapper state elms))
 		 (terminate? (car pair))
 		 (new-state (cdr pair)))
 	    (if terminate?
 		new-state
-		(apply iterate-lists (list mapper new-state rests))))))))
+		(iterate-lists mapper new-state rests)))))))
 
 ;; not yet tested -- YamaKen 2004-10-30
 (define alist-replace
@@ -168,12 +168,20 @@
 
 (define string->symbol intern)
 
-;; accepts up to 2 lists
-(define map mapcar)
+(define map
+  (lambda args
+    (let ((f (car args))
+	  (lists (cdr args)))
+      (if (<= (length lists) 3)  ;; uim's siod accepts up to 3 lists
+	  (apply mapcar args)    ;; faster native processing
+	  (iterate-lists (lambda (state elms)
+			   (if (null? elms)
+			       (cons #t (reverse state))
+			       (let ((mapped (apply f elms)))
+				 (cons #f (cons mapped state)))))
+			 () lists)))))
 
-;; accepts up to 2 lists
-;; process order is guaranteed by siod's mapcar implementation
-(define for-each mapcar)
+(define for-each map)
 
 ;;(define list-tail
 ;;  (lambda (lst n)

Modified: trunk/test/test-util.scm
===================================================================
--- trunk/test/test-util.scm	2005-01-06 11:10:34 UTC (rev 141)
+++ trunk/test/test-util.scm	2005-01-06 12:26:36 UTC (rev 142)
@@ -29,7 +29,7 @@
 ;;; SUCH DAMAGE.
 ;;;;
 
-;; This file is tested with revision 1495
+;; This file is tested with revision 142(new repository)
 
 (use test.unit)
 
@@ -431,7 +431,52 @@
    (assert-equal '(5 7 9)
 		 (uim '(map +
 			    '(1 2 3)
-			    '(4 5 6)))))
+			    '(4 5 6))))
+   (assert-equal '()
+		 (uim '(map +
+			    '()
+			    '()
+			    '())))
+   (assert-equal '(12)
+		 (uim '(map +
+			    '(1)
+			    '(4)
+			    '(7))))
+   (assert-equal '(12 15)
+		 (uim '(map +
+			    '(1 2)
+			    '(4 5)
+			    '(7 8))))
+   (assert-equal '(12 15 18)
+		 (uim '(map +
+			    '(1 2 3)
+			    '(4 5 6)
+			    '(7 8 9))))
+   (assert-equal '()
+		 (uim '(map +
+			    '()
+			    '()
+			    '()
+			    '())))
+   (assert-equal '(22)
+		 (uim '(map +
+			    '(1)
+			    '(4)
+			    '(7)
+			    '(10))))
+   (assert-equal '(22 26)
+		 (uim '(map +
+			    '(1 2)
+			    '(4 5)
+			    '(7 8)
+			    '(10 11))))
+   (assert-equal '(22 26 30)
+		 (uim '(map +
+			    '(1 2 3)
+			    '(4 5 6)
+			    '(7 8 9)
+			    '(10 11 12)))))
+
   ("test for-each"
    (assert-equal 3
 		 (uim '(let ((i 0))