[uim-commit] r815 - in branches/composer: scm test uim
yamaken at freedesktop.org
yamaken at freedesktop.org
Sun Apr 3 06:10:07 PDT 2005
Author: yamaken
Date: 2005-04-03 06:10:04 -0700 (Sun, 03 Apr 2005)
New Revision: 815
Modified:
branches/composer/scm/evmap.scm
branches/composer/scm/util.scm
branches/composer/test/test-uim-util.scm
branches/composer/test/test-util.scm
branches/composer/uim/uim-util.c
Log:
* This commit makes evmap rule tree initialization 1.9 times faster
* scm/evmap.scm
- (event-exp-seq-parse): Optimize a constant value
* scm/util.scm
- (iterate-lists): Remove and replace with faster C version
* uim/uim-util.c
- (shift_elems, iterate_lists): New static function
- (uim_init_util_subrs): Add initialization of iterate-lists
* test/test-uim-util.scm
- (test iterate-lists): Moved from test-util.scm
* test/test-util.scm
- (test iterate-lists): Move to test-uim-util.scm
- (testcase util misc): Fix an broken form
Modified: branches/composer/scm/evmap.scm
===================================================================
--- branches/composer/scm/evmap.scm 2005-04-03 00:29:55 UTC (rev 814)
+++ branches/composer/scm/evmap.scm 2005-04-03 13:10:04 UTC (rev 815)
@@ -439,13 +439,13 @@
;; returns list of ev-exps
(define event-exp-seq-parse
- (lambda (ev-exp-seq)
- (let ((expandeds (event-exp-list-expand-macro ev-exp-seq ())))
- (map (lambda (expanded)
- (map (compose event-exp-collector-exp
- event-exp-collector-fold)
- expanded))
- expandeds))))
+ (let ((canonicalize (compose event-exp-collector-exp
+ event-exp-collector-fold)))
+ (lambda (ev-exp-seq)
+ (let ((expandeds (event-exp-list-expand-macro ev-exp-seq ())))
+ (map (lambda (expanded)
+ (map canonicalize expanded))
+ expandeds)))))
;;
;; action expressions
Modified: branches/composer/scm/util.scm
===================================================================
--- branches/composer/scm/util.scm 2005-04-03 00:29:55 UTC (rev 814)
+++ branches/composer/scm/util.scm 2005-04-03 13:10:04 UTC (rev 815)
@@ -106,21 +106,6 @@
(or (truncate-list lst n)
(error "out of range in list-head")))))
-;; local procedure. don't use in outside of util.scm
-(define iterate-lists
- (lambda (mapper state lists)
- (let ((runs-out? (apply proc-or (mapcar null? lists))))
- (if runs-out?
- (cdr (mapper state ()))
- (let* ((elms (mapcar car lists))
- (rests (mapcar cdr lists))
- (pair (mapper state elms))
- (terminate? (car pair))
- (new-state (cdr pair)))
- (if terminate?
- new-state
- (iterate-lists mapper new-state rests)))))))
-
(define alist-replace
(lambda (kons alist)
(let* ((id (car kons))
Modified: branches/composer/test/test-uim-util.scm
===================================================================
--- branches/composer/test/test-uim-util.scm 2005-04-03 00:29:55 UTC (rev 814)
+++ branches/composer/test/test-uim-util.scm 2005-04-03 13:10:04 UTC (rev 815)
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 362 of new repository
+;; This file is tested with revision 815 of new repository
(use test.unit)
@@ -268,6 +268,17 @@
(assert-equal "1000" (uim '(digit->string 1000)))
(assert-equal "2147483647" (uim '(digit->string 2147483647))))
+ ("test iterate-lists"
+ (assert-equal '(("o" . "O") ("l" . "L") ("l" . "L") ("e" . "E") ("h" . "H"))
+ (uim '(iterate-lists (lambda (state elms)
+ (if (null? elms)
+ (cons #t state)
+ (cons #f (cons (apply cons elms)
+ state))))
+ ()
+ '(("h" "e" "l" "l" "o")
+ ("H" "E" "L" "L" "O" "!"))))))
+
;; compare string sequence
("test str-seq-equal?"
(assert-true (uim-bool '(str-seq-equal? () ())))
Modified: branches/composer/test/test-util.scm
===================================================================
--- branches/composer/test/test-util.scm 2005-04-03 00:29:55 UTC (rev 814)
+++ branches/composer/test/test-util.scm 2005-04-03 13:10:04 UTC (rev 815)
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 268 (new repository)
+;; This file is tested with revision 815 (new repository)
(use test.unit)
@@ -434,16 +434,6 @@
(uim '(list-head lst 10))))
(assert-error (lambda ()
(uim '(list-head lst -1)))))
- ("test iterate-lists"
- (assert-equal '(("o" . "O") ("l" . "L") ("l" . "L") ("e" . "E") ("h" . "H"))
- (uim '(iterate-lists (lambda (state elms)
- (if (null? elms)
- (cons #t state)
- (cons #f (cons (apply cons elms)
- state))))
- ()
- '(("h" "e" "l" "l" "o")
- ("H" "E" "L" "L" "O" "!"))))))
("test alist-replace"
(uim '(define alist ()))
@@ -639,7 +629,7 @@
(assert-equal 0 (uim '(clamp 0 -5 5)))
(assert-equal 1 (uim '(clamp 1 -5 5)))
(assert-equal 2 (uim '(clamp 2 -5 5)))
- (assert-equal 5 (uim '(clamp 10 -5 5))))
+ (assert-equal 5 (uim '(clamp 10 -5 5)))))
(define-uim-test-case "testcase util R5RS procedures"
(setup
Modified: branches/composer/uim/uim-util.c
===================================================================
--- branches/composer/uim/uim-util.c 2005-04-03 00:29:55 UTC (rev 814)
+++ branches/composer/uim/uim-util.c 2005-04-03 13:10:04 UTC (rev 815)
@@ -465,6 +465,69 @@
return string_prefixp_internal(prefix_, str_, strncasecmp);
}
+static uim_lisp
+shift_elems(uim_lisp lists)
+{
+ uim_lisp elms, rests, list;
+
+ if (uim_scm_nullp(lists))
+ return uim_scm_f();
+
+ elms = rests = uim_scm_null_list();
+ for (; !uim_scm_nullp(lists); lists = uim_scm_cdr(lists)) {
+ list = uim_scm_car(lists);
+ if (uim_scm_nullp(list))
+ return uim_scm_f();
+
+ elms = uim_scm_cons(uim_scm_car(list), elms);
+ rests = uim_scm_cons(uim_scm_cdr(list), rests);
+ }
+
+ return uim_scm_cons(uim_scm_reverse(elms),
+ uim_scm_reverse(rests));
+}
+
+static uim_lisp
+iterate_lists(uim_lisp mapper, uim_lisp seed, uim_lisp lists)
+{
+ uim_lisp sym_apply, form;
+ uim_lisp elms, rest, rests, mapped, res, termp, pair;
+ uim_bool single_listp;
+
+ single_listp = (uim_scm_length(lists) == 1) ? UIM_TRUE : UIM_FALSE;
+ sym_apply = uim_scm_make_symbol("apply");
+ res = seed;
+ if (single_listp) {
+ rest = uim_scm_car(lists);
+ } else {
+ rests = lists;
+ }
+ do {
+ if (single_listp) {
+ /* fast path */
+ elms = uim_scm_list1(uim_scm_car(rest));
+ rest = uim_scm_cdr(rest);
+ } else {
+ pair = shift_elems(rests);
+ if (FALSEP(pair)) {
+ elms = rests = uim_scm_null_list();
+ } else {
+ elms = uim_scm_car(pair);
+ rests = uim_scm_cdr(pair);
+ }
+ }
+
+ form = uim_scm_list3(sym_apply,
+ mapper,
+ uim_scm_quote(uim_scm_list2(res, elms)));
+ mapped = uim_scm_eval(form);
+ termp = uim_scm_car(mapped);
+ res = uim_scm_cdr(mapped);
+ } while (FALSEP(termp));
+
+ return res;
+}
+
/* Following is utility functions for C world */
struct _locale_language_table {
char *locale;
@@ -551,6 +614,7 @@
uim_scm_init_subr_1("string-to-list", eucjp_string_to_list);
uim_scm_init_subr_2("string-prefix?", string_prefixp);
uim_scm_init_subr_2("string-prefix-ci?", string_prefix_cip);
+ uim_scm_init_subr_3("iterate-lists", iterate_lists);
uim_scm_init_subr_1("lang-code->lang-name-raw", lang_code_to_lang_name_raw);
uim_scm_init_subr_0("is-set-ugid?", is_setugidp);
}
More information about the Uim-commit
mailing list