klisp

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

commit bcc6430c235a74ac9b0b864aa1203e43b4fdacd6
parent 754ab9e977a02aa8e7f7f7bab78f6d10f92235d8
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 10 May 2011 19:23:59 -0300

Added inexact integers to predicate integer?. But changed type restrictions in indexing combiners (like list-tail, list-ref, encycle! and some string ones) to only accept exact integers (as required by the report because of the implicit type in the use of k, k1 & k2 in the descriptions).

Diffstat:
Msrc/kgnumbers.c | 5+++--
Msrc/kgnumbers.h | 1+
Msrc/kgpair_mut.c | 6+++---
Msrc/kgpairs_lists.c | 4++--
Msrc/kgstrings.c | 12++++++------
Msrc/kobject.h | 6+++++-
6 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/src/kgnumbers.c b/src/kgnumbers.c @@ -34,9 +34,10 @@ bool knumberp(TValue obj) { return ttype(obj) <= K_LAST_NUMBER_TYPE; } bool kimp_intp(TValue obj) { return ttisinteger(obj) || ttiseinf(obj); } /* obj is known to be a number */ bool kfinitep(TValue obj) { return (!ttiseinf(obj) && !ttisiinf(obj)); } -/* TEMP: for now only fixint, bigints & rational, should also include inexact - integers */ +/* fixint, bigints & inexact integers */ 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); } diff --git a/src/kgnumbers.h b/src/kgnumbers.h @@ -27,6 +27,7 @@ bool knumberp(TValue obj); bool kfinitep(TValue obj); bool kintegerp(TValue obj); +bool keintegerp(TValue obj); bool krationalp(TValue obj); bool krealp(TValue obj); bool kexactp(TValue obj); diff --git a/src/kgpair_mut.c b/src/kgpair_mut.c @@ -20,7 +20,7 @@ #include "kghelpers.h" #include "kgpair_mut.h" #include "kgeqp.h" /* eq? checking in memq and assq */ -#include "kgnumbers.h" /* for kpositivep and kintegerp */ +#include "kgnumbers.h" /* for kpositivep and keintegerp */ /* 4.7.1 set-car!, set-cdr! */ void set_carB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) @@ -167,8 +167,8 @@ void encycleB(klisp_State *K, TValue *xparams, TValue ptree, UNUSED(xparams); bind_3tp(K, ptree, "any", anytype, obj, - "integer", kintegerp, tk1, - "integer", kintegerp, tk2); + "exact integer", keintegerp, tk1, + "exact integer", keintegerp, tk2); if (knegativep(tk1) || knegativep(tk2)) { klispE_throw_simple(K, "negative index"); diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c @@ -239,7 +239,7 @@ void list_tail(klisp_State *K, TValue *xparams, TValue ptree, UNUSED(xparams); UNUSED(denv); bind_2tp(K, ptree, "any", anytype, obj, - "integer", kintegerp, tk); + "exact integer", keintegerp, tk); if (knegativep(tk)) { klispE_throw_simple(K, "negative index"); @@ -292,7 +292,7 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) UNUSED(xparams); bind_2tp(K, ptree, "any", anytype, obj, - "integer", kintegerp, tk); + "exact integer", keintegerp, tk); if (knegativep(tk)) { klispE_throw_simple(K, "negative index"); diff --git a/src/kgstrings.c b/src/kgstrings.c @@ -24,7 +24,7 @@ #include "kghelpers.h" #include "kgchars.h" /* for kcharp */ #include "kgstrings.h" -#include "kgnumbers.h" /* for kintegerp & knegativep */ +#include "kgnumbers.h" /* for keintegerp & knegativep */ /* 13.1.1? string? */ /* uses typep */ @@ -34,7 +34,7 @@ void make_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) { UNUSED(xparams); UNUSED(denv); - bind_al1tp(K, ptree, "integer", kintegerp, tv_s, + bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s, maybe_char); char fill = ' '; @@ -71,7 +71,7 @@ void string_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) UNUSED(xparams); UNUSED(denv); bind_2tp(K, ptree, "string", ttisstring, str, - "integer", kintegerp, tv_i); + "exact integer", keintegerp, tv_i); if (!ttisfixint(tv_i)) { /* TODO show index */ @@ -96,7 +96,7 @@ void string_setS(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) UNUSED(xparams); UNUSED(denv); bind_3tp(K, ptree, "string", ttisstring, str, - "integer", kintegerp, tv_i, "char", ttischar, tv_ch); + "exact integer", keintegerp, tv_i, "char", ttischar, tv_ch); if (!ttisfixint(tv_i)) { /* TODO show index */ @@ -245,8 +245,8 @@ void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) UNUSED(xparams); UNUSED(denv); bind_3tp(K, ptree, "string", ttisstring, str, - "integer", kintegerp, tv_start, - "integer", kintegerp, tv_end); + "exact integer", keintegerp, tv_start, + "exact integer", keintegerp, tv_end); if (!ttisfixint(tv_start) || ivalue(tv_start) < 0 || ivalue(tv_start) > kstring_size(str)) { diff --git a/src/kobject.h b/src/kobject.h @@ -31,6 +31,7 @@ #include <stdbool.h> #include <stdint.h> #include <stdio.h> +#include <math.h> #include "klimits.h" #include "klispconf.h" @@ -232,8 +233,11 @@ typedef struct __attribute__ ((__packed__)) GCheader { /* Simple types (value in TValue struct) */ #define ttisfixint(o) (tbasetype_(o) == K_TAG_FIXINT) #define ttisbigint(o) (tbasetype_(o) == K_TAG_BIGINT) -#define ttisinteger(o_) ({ int32_t t_ = tbasetype_(o_); \ +#define ttiseinteger(o_) ({ int32_t t_ = tbasetype_(o_); \ t_ == K_TAG_FIXINT || t_ == K_TAG_BIGINT;}) +#define ttisinteger(o) ({ TValue o__ = (o); \ + (ttiseinteger(o__) || \ + (ttisdouble(o__) && (floor(dvalue(o__)) == dvalue(o__))));}) #define ttisbigrat(o) (tbasetype_(o) == K_TAG_BIGRAT) #define ttisrational(o_) \ ({ TValue t_ = o_; \