mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-07-04 19:12:55 +00:00
Code Issues 1 Releases Wiki Activity

bigint operators and some tests

Browse Source
This commit is contained in:
J.-F. Cap 2019-03-13 22:20:56 +01:00 committed by Calvin Rose
parent 42a0af3b1b
commit 319575c864
4 changed files with 212 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

196
src/core/bigint.c
View File

@ -33,44 +33,51 @@
#include "util.h" #include "util.h"
#endif #endif
typedef int64_t bn_int64; #define MAX_INT_IN_DBL 9007199254740992UL /*2^53*/
typedef uint64_t bn_uint64;
typedef int64_t bi_int64;
typedef uint64_t bi_uint64;
static const JanetAbstractType bn_int64_type = { static Janet int64_get(void *p, Janet key);
static Janet uint64_get(void *p, Janet key);
static const JanetAbstractType bi_int64_type = {
"core/int64", "core/int64",
NULL, NULL,
NULL, NULL,
NULL, int64_get,
NULL, NULL,
NULL, NULL,
NULL NULL
}; };
static const JanetAbstractType bn_uint64_type = { static const JanetAbstractType bi_uint64_type = {
"core/uint64", "core/uint64",
NULL, NULL,
NULL, NULL,
NULL, uint64_get,
NULL, NULL,
NULL, NULL,
NULL NULL
}; };
static int str_to_int64(const char *str, bn_int64 *box, int base) { static int parse_int64(const char *str, bi_int64 *box) {
char *endptr; char *endptr;
int base = (str[0] == '0' && (str[1] == 'x' || str[1] == 'X')) ? 16 : 10;
errno = 0; errno = 0;
*box = (bn_int64)strtoll(str, &endptr, base); *box = (bi_int64)strtoll(str, &endptr, base);
if ((errno == ERANGE && (*box == LLONG_MAX || *box == LLONG_MIN)) || if ((errno == ERANGE && (*box == LLONG_MAX || *box == LLONG_MIN)) ||
(errno != 0 && *box == 0) || (errno != 0 && *box == 0) ||
(endptr == str)) return 0; (endptr == str)) return 0;
return 1; return 1;
} }
static int str_to_uint64(const char *str, bn_uint64 *box, int base) { static int parse_uint64(const char *str, bi_uint64 *box) {
char *endptr; char *endptr;
int base = (str[0] == '0' && (str[1] == 'x' || str[1] == 'X')) ? 16 : 10;
errno = 0; errno = 0;
*box = (bn_int64)strtoull(str, &endptr, base); *box = (bi_int64)strtoull(str, &endptr, base);
if ((errno == ERANGE && (*box == ULLONG_MAX)) || if ((errno == ERANGE && (*box == ULLONG_MAX)) ||
(errno != 0 && *box == 0) || (errno != 0 && *box == 0) ||
(endptr == str)) return 0; (endptr == str)) return 0;
@ -79,13 +86,13 @@ static int str_to_uint64(const char *str, bn_uint64 *box, int base) {
static Janet make_bn_int64(Janet x) { static Janet make_bi_int64(Janet x) {
bn_int64 *box = (bn_int64 *)janet_abstract(&bn_int64_type, sizeof(bn_int64)); bi_int64 *box = (bi_int64 *)janet_abstract(&bi_int64_type, sizeof(bi_int64));
switch (janet_type(x)) { switch (janet_type(x)) {
case JANET_NUMBER : { case JANET_NUMBER : {
double dbl = janet_unwrap_number(x); double dbl = janet_unwrap_number(x);
if (dbl == (bn_int64)dbl) { if (fabs(dbl) <= MAX_INT_IN_DBL) {
*box = (bn_int64)dbl; *box = (bi_int64)dbl;
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
break; break;
@ -93,14 +100,14 @@ static Janet make_bn_int64(Janet x) {
case JANET_STRING: case JANET_STRING:
case JANET_SYMBOL: case JANET_SYMBOL:
case JANET_KEYWORD: { case JANET_KEYWORD: {
if (str_to_int64((const char *)janet_unwrap_string(x), box, 16)) if (parse_int64((const char *)janet_unwrap_string(x), box))
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
break; break;
} }
case JANET_ABSTRACT: { case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x); void *abst = janet_unwrap_abstract(x);
if ((janet_abstract_type(abst) == &bn_int64_type) || (janet_abstract_type(abst) == &bn_uint64_type)) { if ((janet_abstract_type(abst) == &bi_int64_type) || (janet_abstract_type(abst) == &bi_uint64_type)) {
*box = *(bn_int64 *)abst; *box = *(bi_int64 *)abst;
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
break; break;
@ -110,13 +117,13 @@ static Janet make_bn_int64(Janet x) {
return janet_wrap_nil(); return janet_wrap_nil();
} }
static Janet make_bn_uint64(Janet x) { static Janet make_bi_uint64(Janet x) {
bn_uint64 *box = (bn_uint64 *)janet_abstract(&bn_uint64_type, sizeof(bn_uint64)); bi_uint64 *box = (bi_uint64 *)janet_abstract(&bi_uint64_type, sizeof(bi_uint64));
switch (janet_type(x)) { switch (janet_type(x)) {
case JANET_NUMBER : { case JANET_NUMBER : {
double dbl = janet_unwrap_number(x); double dbl = janet_unwrap_number(x);
if (dbl == (bn_uint64)dbl) { if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL)) {
*box = (bn_uint64)dbl; *box = (bi_uint64)dbl;
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
break; break;
@ -124,14 +131,14 @@ static Janet make_bn_uint64(Janet x) {
case JANET_STRING: case JANET_STRING:
case JANET_SYMBOL: case JANET_SYMBOL:
case JANET_KEYWORD: { case JANET_KEYWORD: {
if (str_to_uint64((const char *)janet_unwrap_string(x), box, 16)) if (parse_uint64((const char *)janet_unwrap_string(x), box))
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
break; break;
} }
case JANET_ABSTRACT: { case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x); void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &bn_uint64_type) { if (janet_abstract_type(abst) == &bi_uint64_type) {
*box = *(bn_uint64 *)abst; *box = *(bi_uint64 *)abst;
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
break; break;
@ -142,68 +149,133 @@ static Janet make_bn_uint64(Janet x) {
} }
JanetBigintType janet_is_bigint(Janet x) {
int janet_is_bigint(Janet x, JanetBigintType type) { if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_BIGINT_TYPE_none;
return janet_checktype(x, JANET_ABSTRACT) && const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
(((type == JANET_BIGINT_TYPE_int64) && (janet_abstract_type(janet_unwrap_abstract(x)) == &bn_int64_type)) || return (at == &bi_int64_type) ? JANET_BIGINT_TYPE_int64 : ((at == &bi_uint64_type) ? JANET_BIGINT_TYPE_uint64 : JANET_BIGINT_TYPE_none);
((type == JANET_BIGINT_TYPE_uint64) && (janet_abstract_type(janet_unwrap_abstract(x)) == &bn_uint64_type)));
} }
static Janet janet_getbigint(Janet *argv, int32_t n, JanetBigintType type) {
Janet x = argv[n];
if (type == janet_is_bigint(x)) return x;
return make_bi_int64(x);
}
static Janet cfun_bi_int64_new(int32_t argc, Janet *argv) {
static Janet cfun_bn_int64_new(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
return make_bn_int64(argv[0]); return make_bi_int64(argv[0]);
} }
static Janet cfun_bn_uint64_new(int32_t argc, Janet *argv) { static Janet cfun_bi_uint64_new(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
return make_bn_uint64(argv[0]); return make_bi_uint64(argv[0]);
}
#define OPMETHOD(type,name,oper) \
static Janet cfun_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
bi_##type *box = (bi_##type *)janet_abstract(&bi_##type##_type, sizeof(bi_##type)); \
*box = *(bi_##type *)janet_unwrap_abstract(janet_getbigint(argv,0,JANET_BIGINT_TYPE_##type)); \
for (int i=1;i<argc;i++) \
*box oper##= *(bi_##type *)janet_unwrap_abstract(janet_getbigint(argv,i,JANET_BIGINT_TYPE_##type)); \
return janet_wrap_abstract(box); \
}
#define COMPMETHOD(type,name,oper) \
static Janet cfun_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
bi_##type * box1 = (bi_##type *)janet_unwrap_abstract(janet_getbigint(argv,0,JANET_BIGINT_TYPE_##type)); \
bi_##type * box2 = (bi_##type *)janet_unwrap_abstract(janet_getbigint(argv,1,JANET_BIGINT_TYPE_##type)); \
return janet_wrap_boolean(*box1 oper *box2); \
} }
static Janet cfun_bn_pretty(int32_t argc, Janet *argv) { OPMETHOD(int64, add, +)
janet_fixarity(argc, 1); OPMETHOD(int64, sub, -)
char buf[32]; OPMETHOD(int64, mul, *)
if (janet_checktype(argv[0], JANET_ABSTRACT)) { OPMETHOD(int64, div, /)
void *box = janet_unwrap_abstract(argv[0]);
if (janet_abstract_type(box) == &bn_int64_type) { COMPMETHOD(int64, lt, <)
snprintf(buf, 32, "%li", *(bn_int64 *)box); COMPMETHOD(int64, gt, >)
return janet_cstringv(buf); COMPMETHOD(int64, le, <=)
} COMPMETHOD(int64, ge, >=)
if (janet_abstract_type(box) == &bn_uint64_type) { COMPMETHOD(int64, eq, ==)
snprintf(buf, 32, "%lu", *(bn_uint64 *)box); COMPMETHOD(int64, ne, !=)
return janet_cstringv(buf);
} OPMETHOD(uint64, add, +)
} OPMETHOD(uint64, sub, -)
janet_panicf("expected bigint"); OPMETHOD(uint64, mul, *)
return janet_wrap_nil(); OPMETHOD(uint64, div, /)
COMPMETHOD(uint64, lt, <)
COMPMETHOD(uint64, gt, >)
COMPMETHOD(uint64, le, <=)
COMPMETHOD(uint64, ge, >=)
COMPMETHOD(uint64, eq, ==)
COMPMETHOD(uint64, ne, !=)
static JanetMethod int64_methods[] = {
{"+", cfun_int64_add},
{"-", cfun_int64_sub},
{"*", cfun_int64_mul},
{"/", cfun_int64_div},
{"<", cfun_int64_lt},
{">", cfun_int64_gt},
{"<=", cfun_int64_le},
{">=", cfun_int64_ge},
{"==", cfun_int64_eq},
{"!=", cfun_int64_ne},
{NULL, NULL}
};
static JanetMethod uint64_methods[] = {
{"+", cfun_uint64_add},
{"-", cfun_uint64_sub},
{"*", cfun_uint64_mul},
{"/", cfun_uint64_div},
{"<", cfun_uint64_lt},
{">", cfun_uint64_gt},
{"<=", cfun_uint64_le},
{">=", cfun_uint64_ge},
{"==", cfun_uint64_eq},
{"!=", cfun_uint64_ne},
{NULL, NULL}
};
static Janet int64_get(void *p, Janet key) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD))
janet_panicf("expected keyword, got %v", key);
return janet_getmethod(janet_unwrap_keyword(key), int64_methods);
} }
static Janet uint64_get(void *p, Janet key) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD))
janet_panicf("expected keyword, got %v", key);
return janet_getmethod(janet_unwrap_keyword(key), uint64_methods);
}
static const JanetReg bn_cfuns[] = { static const JanetReg bi_cfuns[] = {
{ {
"bigint/int64", cfun_bn_int64_new, "bigint/int64", cfun_bi_int64_new,
JDOC("(bigint/int64 value )\n\n" JDOC("(bigint/int64 value )\n\n"
"Create new int64.") "Create new int64.")
}, },
{ {
"bigint/uint64", cfun_bn_uint64_new, "bigint/uint64", cfun_bi_uint64_new,
JDOC("(bigint/uint64 value )\n\n" JDOC("(bigint/uint64 value )\n\n"
"Create new uint64.") "Create new uint64.")
}, },
{
"bigint/pretty", cfun_bn_pretty,
JDOC("(bigint/pretty bigint )\n\n"
"return bigint as string")
},
{NULL, NULL, NULL} {NULL, NULL, NULL}
}; };
/* Module entry point */ /* Module entry point */
void janet_lib_bigint(JanetTable *env) { void janet_lib_bigint(JanetTable *env) {
janet_core_cfuns(env, NULL, bn_cfuns); janet_core_cfuns(env, NULL, bi_cfuns);
janet_register_abstract_type(&bn_int64_type); janet_register_abstract_type(&bi_int64_type);
janet_register_abstract_type(&bn_uint64_type); janet_register_abstract_type(&bi_uint64_type);
} }

20
src/core/pp.c
View File

@ -82,17 +82,16 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
#ifdef JANET_BIGINT #ifdef JANET_BIGINT
static void uint64_to_string_b(JanetBuffer *buffer, uint64_t x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%lu", x);
buffer->count += count;
}
static void int64_to_string_b(JanetBuffer *buffer, int64_t x) { static void int64_to_string_b(JanetBuffer *buffer, int64_t x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2); janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%li", x); int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%li", x);
buffer->count += count; buffer->count += count;
} }
static void uint64_to_string_b(JanetBuffer *buffer, uint64_t x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%lu", x);
buffer->count += count;
}
#endif #endif
@ -218,12 +217,13 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
return; return;
case JANET_ABSTRACT: { case JANET_ABSTRACT: {
#ifdef JANET_BIGINT #ifdef JANET_BIGINT
if (janet_is_bigint(x, JANET_BIGINT_TYPE_int64)) { JanetBigintType bt = janet_is_bigint(x);
int64_to_string_b(buffer,*(int64_t *)janet_unwrap_abstract(x)); if (bt == JANET_BIGINT_TYPE_int64) {
int64_to_string_b(buffer, *(int64_t *)janet_unwrap_abstract(x));
return; return;
} }
if (janet_is_bigint(x, JANET_BIGINT_TYPE_uint64)) { if (bt == JANET_BIGINT_TYPE_uint64) {
uint64_to_string_b(buffer,*(uint64_t*)janet_unwrap_abstract(x)); uint64_to_string_b(buffer, *(uint64_t *)janet_unwrap_abstract(x));
return; return;
} }
#endif #endif

3
src/include/janet.h
View File

@ -1324,11 +1324,12 @@ JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, Ja
#ifdef JANET_BIGINT #ifdef JANET_BIGINT
typedef enum { typedef enum {
JANET_BIGINT_TYPE_none,
JANET_BIGINT_TYPE_int64, JANET_BIGINT_TYPE_int64,
JANET_BIGINT_TYPE_uint64, JANET_BIGINT_TYPE_uint64,
} JanetBigintType; } JanetBigintType;
JANET_API int janet_is_bigint(Janet x, JanetBigintType type); JANET_API JanetBigintType janet_is_bigint(Janet x);
#endif #endif

66
test/suite6.janet Normal file
View File

@ -0,0 +1,66 @@
# Copyright (c) 2019 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(start-suite 6)
# some tests for bigint
(assert-no-error
"create some uint64 bigints"
(do
# from number
(def a (bigint/uint64 10))
# max double we can convert to int (2^53)
(def b (bigint/uint64 0x1fffffffffffff))
(def b (bigint/uint64 (math/pow 2 53)))
# from string
(def c (bigint/uint64 "0xffffffffffffffff"))
(def d (bigint/uint64 "123456789"))))
(assert-no-error
"create some int64 bigints"
(do
# from number
(def a (bigint/int64 -10))
# max double we can convert to int (2^53)
(def b (bigint/int64 0x1fffffffffffff))
(def b (bigint/int64 (math/pow 2 53)))
# from string
(def c (bigint/int64 "0x7fffffffffffffff"))
(def d (bigint/int64 "123456789"))))
(assert-error
"bad initializers"
(do
# double to big to be converted to uint64 without truncation (2^53 + 1)
(def b (bigint/uint64 (+ 0xffff_ffff_ffff_ff 1)))
(def b (bigint/uint64 (+ (math/pow 2 53) 1)))
# out of range 65 bits
(def c (bigint/uint64 "0x1ffffffffffffffff"))
# just to big
(def d (bigint/uint64 "123456789123456789123456789"))))
(assert (:== (:/ (bigint/uint64 "0xffffffffffffffff") 8 2) "0xfffffffffffffff") "bigint operations")
(assert (let [a (bigint/uint64 0xff)] (:== (:+ a a a a) (:* a 2 2))) "bigint operations")
(end-suite)