commit 52b1e8a0102d6bdb1f0624affcb3897ae3e08841
parent 936d49763a368fcdf48886a5bb68773ce2a93ecd
Author: Andres Navarro <canavarro82@gmail.com>
Date: Tue, 10 May 2011 20:10:25 -0300
Bugfix: changed type predicate for all numeric comparison predicates to detect no primary value if there was only one operand.
Diffstat:
4 files changed, 24 insertions(+), 18 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -29,7 +29,14 @@
/* use ftypep & ftypep_predp */
/* Helpers for typed predicates */
-bool knumberp(TValue obj) { return ttype(obj) <= K_LAST_NUMBER_TYPE; }
+bool knumberp(TValue obj) { return ttisnumber(obj); }
+/* TEMP used in =? for type predicate (XXX it's not actually a type
+ error, but it's close enough and otherwise should define a
+ new bpredp for numeric predicates...) */
+bool knumber_wpvp(TValue obj)
+{
+ return ttisnumber(obj) && !ttisrwnpv(obj) && !ttisundef(obj);
+}
/* This is used in gcd & lcm */
bool kimp_intp(TValue obj) { return ttisinteger(obj) || ttiseinf(obj); }
/* obj is known to be a number */
@@ -39,8 +46,11 @@ bool kintegerp(TValue obj) { return ttisinteger(obj); }
/* only exact integers (like for indices), bigints & fixints */
bool keintegerp(TValue obj) { return ttiseinteger(obj); }
bool krationalp(TValue obj) { return ttisrational(obj); }
-/* all real are rationals in klisp */
bool krealp(TValue obj) { return ttisreal(obj); }
+/* TEMP used in <? & co for type predicate (XXX it's not actually a type
+ error, but it's close enough and otherwise should define a
+ new bpredp for numeric predicates...) */
+bool kreal_wpvp(TValue obj) { return ttisreal(obj) && !ttisrwnpv(obj); }
bool kexactp(TValue obj) { return ttisexact(obj); }
bool kinexactp(TValue obj) { return ttisinexact(obj); }
@@ -133,12 +143,9 @@ bool knum_eqp(klisp_State *K, TValue n1, TValue n2)
return (tv_equal(n1, n2));
case K_TRWNPV:
case K_TUNDEFINED: /* no primary value, should throw an error */
- /* TODO add irritant */
- klispE_throw_simple(K, "no primary value");
- return false;
+ /* TEMP: this was already contemplated in type predicate */
default:
- /* shouldn't happen */
- assert(0);
+ klispE_throw_simple(K, "unsopported type");
return false;
}
}
@@ -172,12 +179,9 @@ bool knum_ltp(klisp_State *K, TValue n1, TValue n2)
tv_equal(n2, KIPINF));
case K_TRWNPV:
case K_TUNDEFINED: /* no primary value, should throw an error */
- /* TODO add irritant */
- klispE_throw_simple(K, "no primary value");
- return false;
+ /* TEMP: this was already contemplated in type predicate */
default:
- /* shouldn't happen */
- assert(0);
+ klispE_throw_simple(K, "unsopported type");
return false;
}
}
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -25,11 +25,13 @@
/* XXX: this should probably be in a file knumber.h but there is no real need for
that file yet */
bool knumberp(TValue obj);
+bool knumber_wpvp(TValue obj);
bool kfinitep(TValue obj);
bool kintegerp(TValue obj);
bool keintegerp(TValue obj);
bool krationalp(TValue obj);
bool krealp(TValue obj);
+bool kreal_wpvp(TValue obj);
bool kexactp(TValue obj);
bool kinexactp(TValue obj);
bool kundefinedp(TValue obj);
diff --git a/src/kground.c b/src/kground.c
@@ -735,17 +735,17 @@ void kinit_ground_env(klisp_State *K)
/* 12.5.2 =? */
add_applicative(K, ground_env, "=?", ftyped_kbpredp, 3,
- symbol, p2tv(knumberp), p2tv(knum_eqp));
+ symbol, p2tv(knumber_wpvp), p2tv(knum_eqp));
/* 12.5.3 <?, <=?, >?, >=? */
add_applicative(K, ground_env, "<?", ftyped_kbpredp, 3,
- symbol, p2tv(krealp), p2tv(knum_ltp));
+ symbol, p2tv(kreal_wpvp), p2tv(knum_ltp));
add_applicative(K, ground_env, "<=?", ftyped_kbpredp, 3,
- symbol, p2tv(krealp), p2tv(knum_lep));
+ symbol, p2tv(kreal_wpvp), p2tv(knum_lep));
add_applicative(K, ground_env, ">?", ftyped_kbpredp, 3,
- symbol, p2tv(krealp), p2tv(knum_gtp));
+ symbol, p2tv(kreal_wpvp), p2tv(knum_gtp));
add_applicative(K, ground_env, ">=?", ftyped_kbpredp, 3,
- symbol, p2tv(krealp), p2tv(knum_gep));
+ symbol, p2tv(kreal_wpvp), p2tv(knum_gep));
/* 12.5.4 + */
add_applicative(K, ground_env, "+", kplus, 0);
diff --git a/src/kobject.h b/src/kobject.h
@@ -253,7 +253,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
(ttisundef(t_) || ttisdouble(t_) || ttisrwnpv(t_) || ttisiinf(t_)); })
/* For now, all inexact numbers are not robust and have -inf & +inf bounds */
#define ttisrobust(o) (ttisexact(o))
-#define ttisnumber(o) (ttype(o) <= K_LAST_NUMBER_TYPE); })
+#define ttisnumber(o) (ttype(o) <= K_LAST_NUMBER_TYPE)
#define ttiseinf(o) (tbasetype_(o) == K_TAG_EINF)
#define ttisiinf(o) (tbasetype_(o) == K_TAG_IINF)
#define ttisrwnpv(o) (tbasetype_(o) == K_TAG_RWNPV)
