commit dc686e46d16541c4c4fe079a6679eb2a7b8773a3
parent 28bb5650b30f2e830473715f3e1fc714beac9929
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sun, 20 Mar 2011 02:22:59 -0300
Added number?, finite? & integer? to the ground environment.
Diffstat:
6 files changed, 119 insertions(+), 3 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -14,7 +14,7 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o \
- kgpromises.o kgkd_vars.o kgks_vars.o kgports.o kgchars.o
+ kgpromises.o kgkd_vars.o kgks_vars.o kgports.o kgchars.o kgnumbers.o
KRN_T= klisp
KRN_O= klisp.o
@@ -80,7 +80,7 @@ kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h kgpairs_lists.h \
kgpair_mut.h kgenvironments.h kgenv_mut.h kgcombiners.h \
kgcontinuations.h kgencapsulations.h kgpromises.h kgkd_vars.h \
- kgks_vars.h kgports.h kgchars.h
+ kgks_vars.h kgports.h kgchars.h kgnumbers.h
kghelpers.o: kghelpers.c kghelpers.h kstate.h kstate.h klisp.h kpair.h \
kapplicative.h koperative.h kerror.h kobject.h ksymbol.h
kgbooleans.o: kgbooleans.c kgbooleans.c kghelpers.h kstate.h klisp.h \
@@ -127,3 +127,5 @@ kgports.o: kgports.c kgports.h kghelpers.h kstate.h klisp.h \
kpair.h kenvironment.h
kgchars.o: kgchars.c kgchars.h kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h
+kgnumbers.o: kgnumbers.c kgnumbers.h kghelpers.h kstate.h klisp.h \
+ kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h
diff --git a/src/kgchars.h b/src/kgchars.h
@@ -1,5 +1,5 @@
/*
-** kgchars.c
+** kgchars.h
** Characters features for the ground environment
** See Copyright Notice in klisp.h
*/
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -0,0 +1,33 @@
+/*
+** kgnumbers.c
+** Numbers features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kstate.h"
+#include "kobject.h"
+#include "kapplicative.h"
+#include "koperative.h"
+#include "kcontinuation.h"
+#include "kerror.h"
+
+#include "kghelpers.h"
+#include "kgnumbers.h"
+
+/* 15.5.1? number?, finite?, integer? */
+/* use ftypep & ftypep_predp */
+
+bool knumberp(TValue obj) { return ttype(obj) <= K_LAST_NUMBER_TYPE; }
+/* obj is known to be a number */
+bool kfinitep(TValue obj) { return (!ttiseinf(obj) && !ttisiinf(obj)); }
+/* TEMP: for now only fixint, should also include bigints and
+ inexact integers */
+bool kintegerp(TValue obj) { return ttisfixint(obj); }
+
+
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -0,0 +1,31 @@
+/*
+** kgnumbers.h
+** Numbers features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kgnumbers_h
+#define kgnumbers_h
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kobject.h"
+#include "klisp.h"
+#include "kstate.h"
+#include "kghelpers.h"
+
+/* 15.5.1 number?, finite?, integer? */
+/* use ftypep & ftypep_predp */
+
+/* Helpers for typed predicates */
+/* 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 kfinitep(TValue obj);
+bool kintegerp(TValue obj);
+
+#endif
diff --git a/src/kground.c b/src/kground.c
@@ -37,6 +37,7 @@
#include "kgks_vars.h"
#include "kgports.h"
#include "kgchars.h"
+#include "kgnumbers.h"
/*
** BEWARE: this is highly unhygienic, it assumes variables "symbol" and
@@ -472,6 +473,49 @@ void kinit_ground_env(klisp_State *K)
/*
**
+ ** 12 Numbers
+ **
+ */
+
+ /* Only integers and exact infinities for now */
+
+ /*
+ ** 12.5 Number features
+ */
+
+ /* 12.5.1? number?, finite?, integer? */
+ add_applicative(K, ground_env, "number?", ftypep, 2, symbol,
+ p2tv(knumberp));
+ add_applicative(K, ground_env, "finite?", ftyped_predp, 3, symbol,
+ p2tv(knumberp), p2tv(kfinitep));
+ add_applicative(K, ground_env, "integer?", ftypep, 2, symbol,
+ p2tv(kintegerp));
+
+
+ /* ... TODO */
+
+ /*
+ **
+ ** 13 Strings
+ **
+ */
+
+ /*
+ ** 13.1 Primitive features
+ */
+
+ /* TODO */
+
+ /*
+ ** 13.2 Library features
+ */
+
+ /* TODO */
+
+
+
+ /*
+ **
** 14 Characters
**
*/
diff --git a/src/kobject.h b/src/kobject.h
@@ -126,6 +126,9 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TPROMISE 38
#define K_TPORT 39
+/* this is used to test for numbers, as returned by ttype */
+#define K_LAST_NUMBER_TYPE K_TIINF
+
#define K_MAKE_VTAG(t) (K_TAG_TAGGED | (t))
/*
@@ -137,6 +140,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
*/
#define K_TAG_FIXINT K_MAKE_VTAG(K_TFIXINT)
#define K_TAG_EINF K_MAKE_VTAG(K_TEINF)
+#define K_TAG_IINF K_MAKE_VTAG(K_TIINF)
#define K_TAG_NIL K_MAKE_VTAG(K_TNIL)
#define K_TAG_IGNORE K_MAKE_VTAG(K_TIGNORE)
@@ -177,6 +181,8 @@ typedef struct __attribute__ ((__packed__)) GCheader {
/* Simple types (value in TValue struct) */
#define ttisfixint(o) (tbasetype_(o) == K_TAG_FIXINT)
+#define ttiseinf(o) (tbasetype_(o) == K_TAG_EINF)
+#define ttisiinf(o) (tbasetype_(o) == K_TAG_IINF)
#define ttisnil(o) (tbasetype_(o) == K_TAG_NIL)
#define ttisignore(o) (tbasetype_(o) == K_TAG_IGNORE)
#define ttisinert(o) (tbasetype_(o) == K_TAG_INERT)
