klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Msrc/kgnumbers.c | 28++++++++++++++++------------
Msrc/kgnumbers.h | 2++
Msrc/kground.c | 10+++++-----
Msrc/kobject.h | 2+-
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)