[uim-commit] r892 - in trunk: scm uim

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-06-18 11:52:07 -0700 (Sat, 18 Jun 2005)
New Revision: 892

Modified:
   trunk/scm/util.scm
   trunk/uim/slib.c
Log:
* scm/util.scm
  - (delete, alist-delete): Fix default comparison procedure = with
    equal? as described in SRFI-1. Thanks for the report Park Jae-hyeon
* uim/slib.c
  - (inteql): New static function for R5RS compatible "=" procedure
  - (init_subrs): Prepare future replacement of "=" procedure as
    disabled code. Binding "=" with inteql() causes some error, so I
    disabled it for now. It will be enabled in uim 0.5.x series


Modified: trunk/scm/util.scm
===================================================================
--- trunk/scm/util.scm	2005-06-18 16:46:06 UTC (rev 891)
+++ trunk/scm/util.scm	2005-06-18 18:52:07 UTC (rev 892)
@@ -434,7 +434,7 @@
     (let ((x (car args))
 	  (lst (cadr args))
 	  (val=? (if (null? (cddr args))
-		     =
+		     equal?
 		     (car (cddr args)))))
       (filter (lambda (elm)
 		(not (val=? elm x)))
@@ -445,7 +445,7 @@
     (let ((key (car args))
 	  (alist (cadr args))
 	  (key=? (if (null? (cddr args))
-		     =
+		     equal?
 		     (car (cddr args)))))
     (remove (lambda (elm)
 	      (key=? (car elm)

Modified: trunk/uim/slib.c
===================================================================
--- trunk/uim/slib.c	2005-06-18 16:46:06 UTC (rev 891)
+++ trunk/uim/slib.c	2005-06-18 18:52:07 UTC (rev 892)
@@ -82,6 +82,7 @@
   added NESTED_REPL_C_STRING feature (Dec-31-2004) YamaKen
   added heap_alloc_threshold and make configurable (Jan-07-2005) YamaKen
   added support for interactive debugging (Feb-09-2005) Jun Inoue
+  added inteql for "=" predicate (Jun-19-2005) YamaKen
  */
 
 #include "config.h"
@@ -175,6 +176,7 @@
 static LISP setcar (LISP cell, LISP value);
 static LISP intcons (int x);
 static LISP eql (LISP x, LISP y);
+static LISP inteql (LISP x, LISP y);
 static LISP symcons (char *pname, LISP vcell);
 static LISP symbol_boundp (LISP x, LISP env);
 static LISP symbol_value (LISP x, LISP env);
@@ -1996,7 +1998,21 @@
   return (NIL);
 }
 
+static LISP
+inteql (LISP x, LISP y)
+{
+  if NINTNUMP
+    (x) my_err ("number required", x);
+  else if NINTNUMP
+    (y) my_err ("number required", y);
+  else if EQ
+    (x, y) return (sym_t);
+  else if (INTNM (x) == INTNM (y))
+    return (sym_t);
+  return (NIL);
+}
 
+
 static LISP
 append2 (LISP l1, LISP l2)
 {
@@ -4932,7 +4948,11 @@
   init_subr_2 ("equal?", equal);
   init_subr_2 ("eq?", eq);
   init_subr_2 ("eqv?", eql);
-  init_subr_2 ("=", eql);
+#if 0
+  init_subr_2 ("=", inteql);  /* R5RS compatible */
+#else
+  init_subr_2 ("=", eql);     /* loosely accepts non-number objects */
+#endif
   init_subr_2 ("assq", assq);
   init_msubr ("cond", leval_cond);
   init_msubr ("case", leval_case);