commit 99f6d8eadaaefaba9c56f02a4b15f22675431a0e
parent bc4220d6b34b418e39d4470c650b7567345c6533
Author: Andres Navarro <canavarro82@gmail.com>
Date: Fri, 2 Dec 2011 03:45:56 -0300
Added string->number to the ground environment.
Diffstat:
| M | TODO | | | 2 | -- |
| M | src/kgnumbers.c | | | 112 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- |
| M | src/tests/numbers.k | | | 53 | ++++++++++++++++++++++++++++++++++++++++++++++++++--- |
3 files changed, 161 insertions(+), 6 deletions(-)
diff --git a/TODO b/TODO
@@ -21,8 +21,6 @@
* documentation
** update the manual with the current features
** add a section to the manual with the interpreter usage
-* applicatives:
-** string->number (r7rs)
* reader/writer
** syntax support for complex numbers (Kernel report)
* library
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -11,6 +11,7 @@
#include <assert.h>
#include <stdio.h>
+#include <string.h>
#include <stdlib.h>
#include <stdbool.h>
#include <stdint.h>
@@ -2272,6 +2273,8 @@ void kexpt(klisp_State *K)
/* Number<->String conversion */
void number_to_string(klisp_State *K)
{
+ /* MAYBE this code could be factored out and used in kwrite too,
+ but maybe it's too much allocation for kwrite in the simpler cases */
TValue *xparams = K->next_xparams;
TValue ptree = K->next_value;
TValue denv = K->next_env;
@@ -2379,9 +2382,116 @@ void number_to_string(klisp_State *K)
kapply_cc(K, str);
}
-/* TODO */
+struct kspecial_number {
+ const char *ext_rep; /* downcase external representation */
+ TValue obj;
+} kspecial_numbers[] = { { "#e+infinity", KEPINF_ },
+ { "#e-infinity", KEMINF_ },
+ { "#i+infinity", KIPINF_ },
+ { "#i-infinity", KIMINF_ },
+ { "#real", KRWNPV_ },
+ { "#undefined", KUNDEF_ }
+};
+
void string_to_number(klisp_State *K)
{
+ /* MAYBE try to unify with ktoken */
+
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+ UNUSED(denv);
+ UNUSED(xparams);
+
+ bind_al1tp(K, ptree, "string", ttisstring, str, maybe_radix);
+ int radix = 10;
+ if (get_opt_tpar(K, maybe_radix, "radix (2, 8, 10, or 16)", ttisradix))
+ radix = ivalue(maybe_radix);
+
+ /* track length to throw better error msgs */
+ char *buf = kstring_buf(str);
+ int32_t len = kstring_size(str);
+
+ /* if at some point we reach the end of the string
+ the char will be '\0' and will fail all tests,
+ so there is no need to test the length explicitly */
+ bool has_exactp = false;
+ bool exactp = false; /* the default exactness will depend on the format */
+ bool has_radixp = false;
+
+ TValue res = KINERT;
+ size_t snum_size = sizeof(kspecial_numbers) /
+ sizeof(struct kspecial_number);
+ for (int i = 0; i < snum_size; i++) {
+ struct kspecial_number number = kspecial_numbers[i];
+ /* NOTE: must check type because buf may contain embedded '\0's */
+ if (len == strlen(number.ext_rep) &&
+ strcmp(number.ext_rep, buf) == 0) {
+ res = number.obj;
+ break;
+ }
+ }
+ if (ttisinert(res)) {
+ /* number wasn't a special number */
+ while (*buf == '#') {
+ switch(*++buf) {
+ case 'e': case 'E': case 'i': case 'I':
+ if (has_exactp) {
+ klispE_throw_simple_with_irritants(
+ K, "two exactness prefixes", 1, str);
+ return;
+ }
+ has_exactp = true;
+ exactp = (*buf == 'e');
+ ++buf;
+ break;
+ case 'b': case 'B': radix = 2; goto RADIX;
+ case 'o': case 'O': radix = 8; goto RADIX;
+ case 'd': case 'D': radix = 10; goto RADIX;
+ case 'x': case 'X': radix = 16; goto RADIX;
+ RADIX:
+ if (has_radixp) {
+ klispE_throw_simple_with_irritants(
+ K, "two radix prefixes", 1, str);
+ return;
+ }
+ has_radixp = true;
+ ++buf;
+ break;
+ default:
+ klispE_throw_simple_with_irritants(K, "unexpected char "
+ "after #", 1, str);
+ return;
+ }
+ }
+
+ if (radix == 10) {
+ /* only allow decimals with radix 10 */
+ bool decimalp = false;
+ if (!krational_read_decimal(K, buf, radix, &res, NULL, &decimalp)) {
+ klispE_throw_simple_with_irritants(K, "Bad format", 1, str);
+ return;
+ }
+ if (decimalp && !has_exactp) {
+ /* handle decimal format as an explicit #i */
+ has_exactp = true;
+ exactp = false;
+ }
+ } else {
+ if (!krational_read(K, buf, radix, &res, NULL)) {
+ klispE_throw_simple_with_irritants(K, "Bad format", 1, str);
+ return;
+ }
+ }
+
+ if (has_exactp && !exactp) {
+ krooted_tvs_push(K, res);
+ res = kexact_to_inexact(K, res);
+ krooted_tvs_pop(K);
+ }
+ }
+ kapply_cc(K, res);
}
/* init ground */
diff --git a/src/tests/numbers.k b/src/tests/numbers.k
@@ -425,6 +425,8 @@
;; not implemented
;; String conversion
+
+;; 12.? number->string
($check string-ci=? (number->string 0) "0")
($check string-ci=? (number->string 1) "1")
($check string-ci=? (number->string -1) "-1")
@@ -455,7 +457,6 @@
; only bases 2, 8, 10, 16
($check-error (number->string 10 3))
-($check-error (number->string #inert ()))
; only numbers
($check-error (number->string #inert))
($check-error (number->string #inert 2))
@@ -465,4 +466,51 @@
; only base 10 with inexact numbers
($check-error (number->string -1.0 2))
($check-error (number->string 1.25 8))
-($check-error (number->string 3.0 16))
-\ No newline at end of file
+($check-error (number->string 3.0 16))
+
+;; 12.? string->number
+($check =? (string->number "0") 0)
+($check =? (string->number "1") 1)
+($check =? (string->number "-1") -1)
+($check =? (string->number "10" 2) 2)
+($check =? (string->number "-10" 2) -2)
+($check =? (string->number "10" 8) 8)
+($check =? (string->number "-10" 8) -8)
+($check =? (string->number "10" 10) 10)
+($check =? (string->number "-10" 10) -10)
+($check =? (string->number "10" 16) 16)
+($check =? (string->number "-10" 16) -16)
+; default base
+($check =? (string->number "10") (string->number "10" 10))
+;; infinities, undefined and reals with no primary value
+;; #undefined and #real can't be compared with =?
+($check equal? (string->number "#undefined") #undefined)
+($check equal? (string->number "#real") #real)
+($check =? (string->number "#e+infinity") #e+infinity)
+($check =? (string->number "#e-infinity") #e-infinity)
+($check =? (string->number "#i+infinity") #i+infinity)
+($check =? (string->number "#i-infinity") #i-infinity)
+;; rationals
+($check =? (string->number "13/17") 13/17)
+($check =? (string->number "-17/13") -17/13)
+($check =? (string->number "-21/15" 8) #o-21/15)
+;; bigints
+($check =? (string->number "1234567890abcdef" 16)
+ #x1234567890abcdef)
+($check =? (string->number "1234567890ABCDEF" 16)
+ #x1234567890abcdef)
+;; doubles
+($check =? (string->number "1.25e10") 1.25e10)
+($check =? (string->number "-1.25e10" 10) -1.25e10)
+
+; only bases 2, 8, 10, 16
+($check-error (string->number "10" 3))
+; only strings
+($check-error (string->number #inert))
+($check-error (string->number #inert 2))
+($check-error (string->number 2))
+($check-error (string->number 2 8))
+; only base 10 with inexact numbers
+($check-error (string->number "-1.0" 2))
+($check-error (string->number "1.25" 8))
+($check-error (string->number "3.0" 16))
