klisp

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

commit f5468caaf5f5aad02fb5b71204cab9880a6d7c98
parent e7cdd31a3d2bddfc4178e8766c25d1a536b4f337
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri,  6 May 2011 11:38:13 -0300

Added get-real-internal-bounds and get-real-exact-bounds to the ground environment.

Diffstat:
Msrc/kgnumbers.c | 34++++++++++++++++++++++++++++++++++
Msrc/kgnumbers.h | 13+++++++++++--
Msrc/kground.c | 5++++-
3 files changed, 49 insertions(+), 3 deletions(-)

diff --git a/src/kgnumbers.c b/src/kgnumbers.c @@ -1113,6 +1113,40 @@ void kreal_to_exact(klisp_State *K, TValue *xparams, TValue ptree, kapply_cc(K, res); } +/* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */ +void kget_real_internal_bounds(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv) +{ + bind_1tp(K, ptree, "real", krealp, tv_n); + /* TEMP: do it here directly, for now all inexact objects have + [-inf, +inf] bounds */ + TValue res; + if (ttisexact(tv_n)) { + res = klist(K, 2, tv_n, tv_n); + } else { + res = klist(K, 2, KIMINF, KIPINF); + } + kapply_cc(K, res); +} + +void kget_real_exact_bounds(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv) +{ + bind_1tp(K, ptree, "real", krealp, tv_n); + /* TEMP: do it here directly, for now all inexact objects have + [-inf, +inf] bounds, when bounded reals are implemented this + should take care to round the min towards -inf and the max towards + +inf when converting to exact */ + TValue res; + if (ttisexact(tv_n)) { + res = klist(K, 2, tv_n, tv_n); + } else { + res = klist(K, 2, KEMINF, KEPINF); + } + kapply_cc(K, res); +} + + /* 12.8.1 rational? */ /* uses ftypep */ diff --git a/src/kgnumbers.h b/src/kgnumbers.h @@ -116,10 +116,13 @@ void kgcd(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); /* 12.6.1 exact?, inexact?, robust?, undefined? */ -/* TODO */ +/* use fyped_predp */ /* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */ -/* TODO */ +void kget_real_internal_bounds(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv); +void kget_real_exact_bounds(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv); /* 12.6.3 get-real-internal-primary, get-real-exact-primary */ /* TODO */ @@ -160,6 +163,12 @@ void krationalize(klisp_State *K, TValue *xparams, TValue ptree, void ksimplest_rational(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); + +/* 12.9.1 real? */ +/* uses ftypep */ + +/* TODO remaining of module real */ + /* REFACTOR: These should be in a knumber.h header */ /* Misc Helpers */ diff --git a/src/kground.c b/src/kground.c @@ -814,7 +814,10 @@ void kinit_ground_env(klisp_State *K) p2tv(knumberp), p2tv(kundefinedp)); /* 12.6.2 get-real-internal-bounds, get-real-exact-bounds */ - /* TODO */ + add_applicative(K, ground_env, "get-real-internal-bounds", + kget_real_internal_bounds, 0); + add_applicative(K, ground_env, "get-real-exact-bounds", + kget_real_exact_bounds, 0); /* 12.6.3 get-real-internal-primary, get-real-exact-primary */ /* TODO */