commit ad944376712e0bc6fc6cf2b8e2419ef115eb2462
parent 40fed32579f512c2b58d5fcc7521790589953674
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 19 Oct 2011 14:57:02 -0300
Bugfix kpositivep and knegativep should't take a klispState. Corrected some number tests and added rationale.
Diffstat:
7 files changed, 114 insertions(+), 53 deletions(-)
diff --git a/src/kgblobs.c b/src/kgblobs.c
@@ -43,7 +43,7 @@ void make_blob(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
fill = ivalue(maybe_byte);
}
- if (knegativep(K, tv_s)) {
+ if (knegativep(tv_s)) {
klispE_throw_simple(K, "negative size");
return;
} else if (!ttisfixint(tv_s)) {
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -804,9 +804,9 @@ TValue knum_simplest_rational(klisp_State *K, TValue n1, TValue n2)
klispE_throw_simple(K, "x0 doesn't exists (n1 == n2 & "
"irrational)");
return KINERT;
- } else if (knegativep(K, n1) && kpositivep(K, n2)) {
+ } else if (knegativep(n1) && kpositivep(n2)) {
return i2tv(0);
- } else if (knegativep(K, n1)) {
+ } else if (knegativep(n1)) {
/* n1 -inf, n2 finite negative */
/* ASK John: is this behaviour for infinities ok? */
/* Also in the report example both 1/3 & 1/2 are simpler than
@@ -822,9 +822,9 @@ TValue knum_simplest_rational(klisp_State *K, TValue n1, TValue n2)
if (tv_equal(n1, n2)) {
klispE_throw_simple(K, "result with no primary value");
return KINERT;
- } else if (knegativep(K, n1) && kpositivep(K, n2)) {
+ } else if (knegativep(n1) && kpositivep(n2)) {
return d2tv(0.0);
- } else if (knegativep(K, n1)) {
+ } else if (knegativep(n1)) {
/* n1 -inf, n2 finite negative */
/* ASK John: is this behaviour for infinities ok? */
/* Also in the report example both 1/3 & 1/2 are simpler than
@@ -950,9 +950,9 @@ void kplus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!all_zero)
cres = KRWNPV; /* check is made later */
} else if (all_exact)
- cres = knegativep(K, cres)? KEMINF : KEPINF;
+ cres = knegativep(cres)? KEMINF : KEPINF;
else
- cres = knegativep(K, cres)? KIMINF : KIPINF;
+ cres = knegativep(cres)? KIMINF : KIPINF;
/* here if any of the two has no primary an error is signaled */
res = knum_plus(K, ares, cres);
@@ -1011,7 +1011,7 @@ void ktimes(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
; /* do nothing */
if (kfast_zerop(cres))
; /* do nothing */
- else if (kpositivep(K, cres) && knum_ltp(K, cres, i2tv(1))) {
+ else if (kpositivep(cres) && knum_ltp(K, cres, i2tv(1))) {
if (all_exact)
cres = i2tv(0);
else
@@ -1104,9 +1104,9 @@ void kminus(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (!all_zero)
cres = KRWNPV; /* check is made later */
} else if (all_exact)
- cres = knegativep(K, cres)? KEMINF : KEPINF;
+ cres = knegativep(cres)? KEMINF : KEPINF;
else
- cres = knegativep(K, cres)? KIMINF : KIPINF;
+ cres = knegativep(cres)? KIMINF : KIPINF;
/* here if any of the two has no primary an error is signaled */
res = knum_plus(K, ares, cres);
@@ -1356,7 +1356,7 @@ void kdiv_mod(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* use ftyped_predp */
/* Helpers for positive?, negative?, odd? & even? */
-bool kpositivep(klisp_State *K, TValue n)
+bool kpositivep(TValue n)
{
switch (ttype(n)) {
case K_TFIXINT:
@@ -1369,17 +1369,15 @@ bool kpositivep(klisp_State *K, TValue n)
return kbigrat_positivep(n);
case K_TDOUBLE:
return dvalue(n) > 0.0;
- case K_TRWNPV:
- klispE_throw_simple_with_irritants(K, "no primary value", 1, n);
- return false;
- /* complex and undefined should be captured by type predicate */
+ /* real with no prim value, complex and undefined should be captured by
+ type predicate */
default:
- klispE_throw_simple(K, "unsupported type");
+ klisp_assert(0);
return false;
}
}
-bool knegativep(klisp_State *K, TValue n)
+bool knegativep(TValue n)
{
switch (ttype(n)) {
case K_TFIXINT:
@@ -1392,12 +1390,10 @@ bool knegativep(klisp_State *K, TValue n)
return kbigrat_negativep(n);
case K_TDOUBLE:
return dvalue(n) < 0.0;
- case K_TRWNPV:
- klispE_throw_simple_with_irritants(K, "no primary value", 1, n);
- return false;
- /* complex and undefined should be captured by type predicate */
+ /* real with no prim value, complex and undefined should be captured by
+ type predicate */
default:
- klispE_throw_simple(K, "unsupported type");
+ klisp_assert(0);
return false;
}
}
@@ -1412,6 +1408,8 @@ bool koddp(TValue n)
return kbigint_oddp(n);
case K_TDOUBLE:
return fmod(dvalue(n), 2.0) != 0.0;
+ /* real with no prim value, complex and undefined should be captured by
+ type predicate */
default:
assert(0);
return false;
@@ -1427,6 +1425,8 @@ bool kevenp(TValue n)
return kbigint_evenp(n);
case K_TDOUBLE:
return fmod(dvalue(n), 2.0) == 0.0;
+ /* real with no prim value, complex and undefined should be captured by
+ type predicate */
default:
assert(0);
return false;
@@ -1745,7 +1745,7 @@ void kdivided(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
; /* do nothing */
if (kfast_zerop(cres))
; /* do nothing */
- else if (kpositivep(K, cres) && knum_ltp(K, cres, i2tv(1))) {
+ else if (kpositivep(cres) && knum_ltp(K, cres, i2tv(1))) {
if (all_exact)
cres = i2tv(0);
else
@@ -1870,7 +1870,7 @@ void kexp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
case K_TEINF: /* in any case return inexact result (e is inexact) */
case K_TIINF:
- res = kpositivep(K, n)? KIPINF : d2tv(0.0);
+ res = kpositivep(n)? KIPINF : d2tv(0.0);
break;
case K_TRWNPV:
case K_TUNDEFINED:
@@ -1895,7 +1895,7 @@ void klog(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (kfast_zerop(n)) {
klispE_throw_simple_with_irritants(K, "zero argument", 1, n);
return;
- } else if (knegativep(K, n)) {
+ } else if (knegativep(n)) {
klispE_throw_simple_with_irritants(K, "negative argument", 1, n);
return;
}
@@ -2083,7 +2083,7 @@ void katan(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
} else {
/* XXX either pi/2 or -pi/2, but we don't have the constant */
- double d = kpositivep(K, n1)? atan(INFINITY) : atan(-INFINITY);
+ double d = kpositivep(n1)? atan(INFINITY) : atan(-INFINITY);
res = ktag_double(d);
}
break;
@@ -2131,7 +2131,7 @@ void ksqrt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
case K_TEINF:
case K_TIINF:
- res = knegativep(K, n)? KUNDEF : KIPINF;
+ res = knegativep(n)? KUNDEF : KIPINF;
break;
case K_TRWNPV:
case K_TUNDEFINED:
@@ -2174,15 +2174,15 @@ void kexpt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
case K_TEINF:
case K_TIINF:
if (ttisinf(n1) && ttisinf(n2)) {
- if (knegativep(K, n1) && knegativep(K, n2))
+ if (knegativep(n1) && knegativep(n2))
res = d2tv(0.0);
- else if (knegativep(K, n1) || knegativep(K, n2))
+ else if (knegativep(n1) || knegativep(n2))
res = KUNDEF; /* ASK John: is this ok? */
else
res = KIPINF;
} else if (ttisinf(n1)) {
- if (knegativep(K, n1)) {
- if (knegativep(K, n2))
+ if (knegativep(n1)) {
+ if (knegativep(n2))
res = d2tv(0.0);
else {
TValue num = knum_numerator(K, n2);
@@ -2194,9 +2194,9 @@ void kexpt(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
res = KIPINF;
}
} else { /* ttisinf(n2) */
- if (knegativep(K, n2))
+ if (knegativep(n2))
res = d2tv(0.0);
- else if (knegativep(K, n1))
+ else if (knegativep(n1))
res = KUNDEF; /* ASK John: is this ok? */
else
res = KIPINF;
diff --git a/src/kgnumbers.h b/src/kgnumbers.h
@@ -84,8 +84,8 @@ bool kzerop(TValue n);
/* use ftyped_predp */
/* Helpers for positive?, negative?, odd? & even? */
-bool kpositivep(klisp_State *K, TValue n);
-bool knegativep(klisp_State *K, TValue n);
+bool kpositivep(TValue n);
+bool knegativep(TValue n);
bool koddp(TValue n);
bool kevenp(TValue n);
@@ -218,7 +218,7 @@ inline TValue kneg_inf(TValue i)
inline bool knum_same_signp(klisp_State *K, TValue n1, TValue n2)
{
- return kpositivep(K, n1) == kpositivep(K, n2);
+ return kpositivep(n1) == kpositivep(n2);
}
/* init ground */
diff --git a/src/kgpair_mut.c b/src/kgpair_mut.c
@@ -170,7 +170,7 @@ void encycleB(klisp_State *K, TValue *xparams, TValue ptree,
"exact integer", keintegerp, tk1,
"exact integer", keintegerp, tk2);
- if (knegativep(K, tk1) || knegativep(K, tk2)) {
+ if (knegativep(tk1) || knegativep(tk2)) {
klispE_throw_simple(K, "negative index");
return;
}
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -241,7 +241,7 @@ void list_tail(klisp_State *K, TValue *xparams, TValue ptree,
bind_2tp(K, ptree, "any", anytype, obj,
"exact integer", keintegerp, tk);
- if (knegativep(K, tk)) {
+ if (knegativep(tk)) {
klispE_throw_simple(K, "negative index");
return;
}
@@ -294,7 +294,7 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
bind_2tp(K, ptree, "any", anytype, obj,
"exact integer", keintegerp, tk);
- if (knegativep(K, tk)) {
+ if (knegativep(tk)) {
klispE_throw_simple(K, "negative index");
return;
}
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -41,7 +41,7 @@ void make_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
if (get_opt_tpar(K, "make-string", K_TCHAR, &maybe_char))
fill = chvalue(maybe_char);
- if (knegativep(K, tv_s)) {
+ if (knegativep(tv_s)) {
klispE_throw_simple(K, "negative size");
return;
} else if (!ttisfixint(tv_s)) {
diff --git a/src/tests/numbers.k b/src/tests/numbers.k
@@ -164,12 +164,12 @@
;; 12.5.10 positive? negative?
($check-predicate (positive? 1 1.0 1/1 999999999999 #e+infinity))
-($check-not-predicate (positive? 0)) ; FAIL
-($check-not-predicate (positive? #e-infinity)) ; FAIL
+($check-not-predicate (positive? 0))
+($check-not-predicate (positive? #e-infinity))
($check-error (positive? #real))
($check-error (positive? #undefined))
-($check-predicate (negative? -1 -1.0 -1/1 -999999999999 #e-infinity)) ; FAIL
+($check-predicate (negative? -1 -1.0 -1/1 -999999999999 #e-infinity))
($check-not-predicate (negative? 0))
($check-not-predicate (negative? #e+infinity))
($check-error (negative? #real))
@@ -219,7 +219,16 @@
($check-not-predicate (inexact? #e+infinity))
($check-predicate (robust? 0 1 -1 1/3 999999999999 #e-infinity #e+infinity))
-($check-predicate (robust? 3.14)) ; FAIL
+;; For now klisp doesn't support precise bounds or robust tagging of inexact
+;; numbers. This is, however, allowed by the report (see section 12.2,
+;; Inexactness):
+;;
+;; "(...) The implementation might simply take all inexact real numbers
+;; to be non-robust with upper bound positive infinity and lower bound
+;; negative infinity (...)"
+;;
+;; Andres Navarro
+;; ($check-predicate (robust? 3.14)) ; FAIL
($check-not-predicate (robust? #real))
($check-not-predicate (robust? #undefined))
@@ -249,7 +258,28 @@
;; 12.8.1 rational?
($check-predicate (rational? 0 1 1/2))
-($check-not-predicate (rational? (sqrt 2))) ; FAIL
+;; For now (and probably forever) klisp doesn't support non-rational
+;; reals. While this is certainly doable it implies the use of a complex
+;; algebraic module that is well beyond the scope of this project.
+;; See following paragraph from the report: "It would seem a daunting task to
+;; implement module Real without module Inexact, but in case someone has a
+;; reason to do so, the report doesn’t preclude it, i.e., module Real doesn’t
+;; assume module Inexact."
+;;
+;; Then, in section 12.2, Inexactness, it says: " However, sometimes
+;; there may be no way for an internal number to capture a mathematical
+;; number that the client wants to reason about, either because the intended
+;; mathematical number cannot be represented by an internal number (as with
+;; exclusively rational internal number formats confronted with an irrational
+;; mathematical number) ..."
+;; and then on the definition of rational? (12.8.1)
+;; "An inexact real is a rational iff its primary value is a ratio of
+;; integers." which is true of all finite reals supported by klisp
+;; as they are represented in floating point format and are therefore
+;; expressible by the formula (sign + or -) mantissa / 2 ^ (-expt)
+;;
+;; Andres Navarro
+; was ($check-not-predicate (rational? (sqrt 2))) ; FAIL
($check-not-predicate (rational? #e+infinity))
;; 12.8.2 /
@@ -268,17 +298,32 @@
;; 12.8.4 floor ceiling truncate bound
+;; By my interpretation of the report, these applicatives return inexact
+;; integers (they could in principle return exact integers if the reals
+;; passed were correctly bounded, and this is the case in klisp for exact
+;; rationals for example, but not for inexact reals in general). The report
+;; only says that exact arguments means exact results (when possible).
+;; I could be wrong of course, I should consult this with John Shutt
+;;
+;; Andres Navarro
+
($check equal? (floor 0) 0)
-($check equal? (floor 1.23) 1) ; FAIL
-($check equal? (floor -1.23) -2) ; FAIL
+($check equal? (floor #e1.23) 1)
+($check equal? (floor #e-1.23) -2)
+($check =? (floor 1.23) 1)
+($check =? (floor -1.23) -2)
($check equal? (ceiling 0) 0)
-($check equal? (ceiling 1.23) 2) ; FAIL
-($check equal? (ceiling -1.23) -1) ; FAIL
+($check equal? (ceiling #e1.23) 2)
+($check equal? (ceiling #e-1.23) -1)
+($check =? (ceiling 1.23) 2)
+($check =? (ceiling -1.23) -1)
($check equal? (truncate 0) 0)
-($check equal? (truncate 1.99) 1) ; FAIL
-($check equal? (truncate -1.99) -1) ; FAIL
+($check equal? (truncate #e1.99) 1)
+($check equal? (truncate #e-1.99) -1)
+($check =? (truncate 1.99) 1)
+($check =? (truncate -1.99) -1)
($check equal? (round 0) 0)
($check equal? (round 1/2) 0)
@@ -293,10 +338,26 @@
;; 12.8.5 rationalize simplest-rational
($check equal? (rationalize 0 1) 0)
-($check equal? (rationalize 0.1 0.05) 1/6) ; FAIL
+
+;; I would think the same as for floor, truncate, etc apply here
+;; Here the reports even says this explicitly, in 12.8.5:
+;; "If real1 and real2 are exact, the applicative (whichever it is)
+;; returns exact x0. If one or both of real1 and real2 are inexact,
+;; the applicative returns an inexact approximating x0
+;; (as by real->inexact , §12.6.5).
+;;
+;; Andres Navarro
+
+;; (I think you meant 1/7 here, 1/6 is about 0.16, and so, outside the range)
+;;
+;; Andres Navarro
+;; was ($check equal? (rationalize 0.1 0.05) 1/6) ; FAIL
+($check =? (rationalize 0.1 0.05) 1/7)
+($check equal? (rationalize #e0.1 #e0.05) 1/7)
($check equal? (simplest-rational 2/7 3/5) 1/2)
-($check equal? (simplest-rational 0.1 0.3) 1/4) ; FAIL
+($check =? (simplest-rational 0.1 0.3) 1/4)
+($check equal? (simplest-rational #e0.1 #e0.3) 1/4)
;; 12.9.1 real?
