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:
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_; \
