commit 986e75653f1c68b688dbc604a9c1a2fd40e20872
parent 641b5ac451f08a28afaf736b5db525b8b538c733
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sat, 30 Apr 2011 22:58:23 -0300
Added some type definitions for inexact real. Added kreal.[ch] and skeleton for exact_to_inexact
Diffstat:
6 files changed, 108 insertions(+), 18 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -11,7 +11,7 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kwrite.o kstate.o kmem.o kerror.o kauxlib.o kenvironment.o \
kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
kencapsulation.o kpromise.o kport.o kinteger.o krational.o \
- ktable.o kgc.o imath.o imrat.o \
+ kreal.o ktable.o kgc.o imath.o imrat.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 \
@@ -45,21 +45,22 @@ klisp.o: klisp.c klisp.h kobject.h kread.h kwrite.h klimits.h kstate.h kmem.h \
kapplicative.h koperative.h keval.h krepl.h kground.h
kobject.o: kobject.c kobject.h klimits.h klispconf.h
ktoken.o: ktoken.c ktoken.h kobject.h kstate.h kpair.h kstring.h ksymbol.h \
- kerror.h klisp.h kinteger.h krational.h kport.h
+ kerror.h klisp.h kinteger.h krational.h kreal.h kport.h
kinteger.o: kinteger.c kinteger.h kobject.h kstate.h kmem.h klisp.h imath.h \
kgc.h
-krational.o: krational.c krational.h kinteger.h kobject.h kstate.h kmem.h klisp.h \
- imrat.h kgc.h
+krational.o: krational.c krational.h kinteger.h kobject.h kstate.h kmem.h \
+ klisp.h imrat.h kgc.h
+kreal.o: kreal.c kreal.h krational.h kinteger.h kobject.h kstate.h kmem.h \
+ klisp.h imrat.h kgc.h
kpair.o: kpair.c kpair.h kobject.h kstate.h kmem.h klisp.h kgc.h
kstring.o: kstring.c kstring.h kobject.h kstate.h kmem.h klisp.h kgc.h
-# XXX: kpair.h because of use of list as symbol table
-ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstring.h kstate.h kmem.h \
+ksymbol.o: ksymbol.c ksymbol.h kobject.h kstring.h kstate.h kmem.h \
klisp.h kgc.h
kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h klisp.h \
kport.h ktable.h klispconf.h
kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
- klisp.h kport.h kinteger.h krational.h ktable.h klispconf.h \
- kenvironment.h
+ klisp.h kport.h kinteger.h krational.h kreal.h ktable.h klispconf.h \
+ kenvironment.h
# XXX: now that all dealloc code is in gc, many of these are unnecessary
kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
kenvironment.h kpair.h keval.h koperative.h kground.h \
@@ -103,7 +104,7 @@ kgbooleans.o: kgbooleans.c kgbooleans.c kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kpair.h kcontinuation.h ksymbol.h
kgeqp.o: kgeqp.c kgeqp.c kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kpair.h kcontinuation.h kapplicative.h \
- kinteger.h krational.h
+ kinteger.h krational.h kreal.h
kgequalp.o: kgequalp.c kgequalp.c kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kpair.h kcontinuation.h kgeqp.h kstring.h
kgsymbols.o: kgsymbols.c kgsymbols.c kghelpers.h kstate.h klisp.h \
@@ -148,11 +149,11 @@ 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 \
- ksymbol.h kinteger.h krational.h
+ ksymbol.h kinteger.h krational.h kreal.h
kgstrings.o: kgstrings.c kgstrings.h kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h \
kstring.h ksymbol.h kgnumbers.h
imath.o: kobject.h kstate.h kmem.h kerror.h
imrath.o: kobject.h kstate.h kmem.h kerror.h
kgc.o: kgc.c kgc.h kobject.h kmem.h kstate.h kport.h imath.h imrat.h \
- ktable.h kstring.h kerror.h
+ ktable.h kstring.h kerror.h kinteger.h krational.h
diff --git a/src/kobject.c b/src/kobject.c
@@ -20,6 +20,10 @@ const TValue ktrue = KTRUE_;
const TValue kfalse = KFALSE_;
const TValue kepinf = KEPINF_;
const TValue keminf = KEMINF_;
+const TValue kipinf = KIPINF_;
+const TValue kiminf = KIMINF_;
+const TValue krwnpv = KRWNPV_;
+const TValue kundef = KUNDEF_;
const TValue kspace = KSPACE_;
const TValue knewline = KNEWLINE_;
const TValue kfree = KFREE_;
@@ -36,7 +40,9 @@ char *ktv_names[] = {
[K_TDOUBLE] = "double",
[K_TBDOUBLE] = "bdouble",
[K_TIINF] = "iinf",
- [K_TRWNPN] = "rwnpn",
+
+ [K_TRWNPV] = "rwnpv",
+ [K_TUNDEFINED] = "undefined",
[K_TCOMPLEX] = "complex",
[K_TNIL] = "nil",
diff --git a/src/kobject.h b/src/kobject.h
@@ -134,8 +134,9 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TDOUBLE 5
#define K_TBDOUBLE 6
#define K_TIINF 7
-#define K_TRWNPN 8
+#define K_TRWNPV 8
#define K_TCOMPLEX 9
+#define K_TUNDEFINED 10
#define K_TNIL 20
#define K_TIGNORE 21
@@ -183,6 +184,8 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TAG_BIGRAT K_MAKE_VTAG(K_TBIGRAT)
#define K_TAG_EINF K_MAKE_VTAG(K_TEINF)
#define K_TAG_IINF K_MAKE_VTAG(K_TIINF)
+#define K_TAG_RWNPV K_MAKE_VTAG(K_TRWNPV)
+#define K_TAG_UNDEFINED K_MAKE_VTAG(K_TUNDEFINED)
#define K_TAG_NIL K_MAKE_VTAG(K_TNIL)
#define K_TAG_IGNORE K_MAKE_VTAG(K_TIGNORE)
@@ -232,12 +235,17 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttisinteger(o_) ({ int32_t t_ = tbasetype_(o_); \
t_ == K_TAG_FIXINT || t_ == K_TAG_BIGINT;})
#define ttisbigrat(o) (tbasetype_(o) == K_TAG_BIGRAT)
-#define ttisrational(o_) ({ int32_t t_ = tbasetype_(o_); \
- t_ == K_TAG_BIGRAT || t_== K_TAG_BIGINT || \
- t_ == K_TAG_FIXINT;})
+#define ttisrational(o_) \
+ ({ TValue t_ = o_; \
+ (ttype(t_) <= K_TBIGRAT) || ttisdouble(t_); })
+#define ttisdouble(o) ((ttag(o) & K_TAG_BASE_MASK) != K_TAG_TAGGED)
+#define ttisreal(o) (ttype(o) < K_TCOMPLEX)
#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)
+#define ttisundef(o) (tbasetype_(o) == K_TAG_UNDEFINED)
+
#define ttisnil(o) (tbasetype_(o) == K_TAG_NIL)
#define ttisignore(o) (tbasetype_(o) == K_TAG_IGNORE)
#define ttisinert(o) (tbasetype_(o) == K_TAG_INERT)
@@ -245,7 +253,6 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttisboolean(o) (tbasetype_(o) == K_TAG_BOOLEAN)
#define ttischar(o) (tbasetype_(o) == K_TAG_CHAR)
#define ttisfree(o) (tbasetype_(o) == K_TAG_FREE)
-#define ttisdouble(o) ((ttag(o) & K_TAG_BASE_MASK) != K_TAG_TAGGED)
/* Complex types (value in heap),
(bigints, rationals, etc could be collectable)
@@ -524,6 +531,10 @@ union GCObject {
#define KFALSE_ {.tv = {.t = K_TAG_BOOLEAN, .v = { .b = false }}}
#define KEPINF_ {.tv = {.t = K_TAG_EINF, .v = { .i = 1 }}}
#define KEMINF_ {.tv = {.t = K_TAG_EINF, .v = { .i = -1 }}}
+#define KIPINF_ {.tv = {.t = K_TAG_IINF, .v = { .i = 1 }}}
+#define KIMINF_ {.tv = {.t = K_TAG_IINF, .v = { .i = -1 }}}
+#define KRWNPV_ {.tv = {.t = K_TAG_RWNPV, .v = { .i = 0 }}}
+#define KUNDEF_ {.tv = {.t = K_TAG_UNDEFINED, .v = { .i = 0 }}}
#define KSPACE_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = ' ' }}}
#define KNEWLINE_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\n' }}}
#define KFREE_ {.tv = {.t = K_TAG_FREE, .v = { .i = 0 }}}
@@ -538,6 +549,10 @@ union GCObject {
#define KFALSE ((TValue) KFALSE_)
#define KEPINF ((TValue) KEPINF_)
#define KEMINF ((TValue) KEMINF_)
+#define KIPINF ((TValue) KIPINF_)
+#define KIMINF ((TValue) KIMINF_)
+#define KRWNPV ((TValue) KRWNPV_)
+#define KUNDEF ((TValue) KUNDEF_)
#define KSPACE ((TValue) KSPACE_)
#define KNEWLINE ((TValue) KNEWLINE_)
#define KFREE ((TValue) KFREE_)
@@ -551,6 +566,10 @@ const TValue ktrue;
const TValue kfalse;
const TValue kepinf;
const TValue keminf;
+const TValue kipinf;
+const TValue kiminf;
+const TValue krwnpv;
+const TValue kundef;
const TValue kspace;
const TValue knewline;
const TValue kfree;
@@ -560,12 +579,14 @@ const TValue kfree;
#define i2tv_(i_) {.tv = {.t = K_TAG_FIXINT, .v = { .i = (i_) }}}
#define b2tv_(b_) {.tv = {.t = K_TAG_BOOLEAN, .v = { .b = (b_) }}}
#define p2tv_(p_) {.tv = {.t = K_TAG_USER, .v = { .p = (p_) }}}
+#define d2tv_(d_) {.d = d_}
/* Macros to create TValues of non-heap allocated types */
#define ch2tv(ch_) ((TValue) ch2tv_(ch_))
#define i2tv(i_) ((TValue) i2tv_(i_))
#define b2tv(b_) ((TValue) b2tv_(b_))
#define p2tv(p_) ((TValue) p2tv_(p_))
+#define d2tv(d_) ((TValue) d2tv_(d_))
/* Macros to convert a GCObject * into a tagged value */
/* TODO: add assertions */
@@ -620,6 +641,7 @@ const TValue kfree;
#define chvalue(o_) ((o_).tv.v.ch)
#define gcvalue(o_) ((o_).tv.v.gc)
#define pvalue(o_) ((o_).tv.v.p)
+#define dvalue(o_) ((o_).d)
/* Macro to obtain a string describing the type of a TValue */#
#define ttname(tv_) (ktv_names[ttype(tv_)])
diff --git a/src/kreal.c b/src/kreal.c
@@ -0,0 +1,41 @@
+/*
+** kreal.c
+** Kernel Reals (doubles)
+** See Copyright Notice in klisp.h
+*/
+
+#include <stdbool.h>
+#include <stdint.h>
+#include <string.h>
+#include <inttypes.h>
+#include <ctype.h>
+#include <math.h>
+
+#include "kreal.h"
+#include "krational.h"
+#include "kinteger.h"
+#include "kobject.h"
+#include "kstate.h"
+#include "kmem.h"
+#include "kgc.h"
+
+TValue kexact_to_inexact(klisp_State *K, TValue n)
+{
+ switch(ttype(n)) {
+ case K_TFIXINT:
+ case K_TBIGINT:
+ case K_TBIGRAT:
+ case K_TEINF:
+ /* TODO */
+ klisp_assert(0);
+ /* all of these are already inexact */
+ case K_TDOUBLE:
+ case K_TIINF:
+ case K_TRWNPV:
+ case K_TUNDEFINED:
+ return n;
+ default:
+ klisp_assert(0);
+ return KINERT;
+ }
+}
diff --git a/src/kreal.h b/src/kreal.h
@@ -0,0 +1,21 @@
+/*
+** kreal.c
+** Kernel Reals (doubles)
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kreal_h
+#define kreal_h
+
+#include <stdbool.h>
+#include <stdint.h>
+#include <inttypes.h>
+
+#include "kobject.h"
+#include "kstate.h"
+#include "kinteger.h"
+#include "imrat.h"
+
+TValue kexact_to_inexact(klisp_State *K, TValue n);
+
+#endif
diff --git a/src/ksymbol.c b/src/ksymbol.c
@@ -10,7 +10,6 @@
#include "kobject.h"
/* for identifier checking */
#include "ktoken.h"
-#include "kpair.h"
#include "kstate.h"
#include "kmem.h"
#include "kgc.h"
