mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

First commit removing the integer number type. This should 

remove some complexity and unexpected behavior around numbers in
general as all numbers are the same number type, IEEE 754 double
precision numbers. Also update examples and tests, some of which were
out of date.

Some more testing may be needed for new changes to numbers.
This commit is contained in:
Calvin Rose 2018-12-27 13:05:29 -05:00
parent 5a3190d471
commit 6b95326d7c
29 changed files with 543 additions and 790 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ctest/system_test.c
View File

@ -43,8 +43,8 @@ int main() {
assert(janet_equals(janet_wrap_integer(INT32_MAX), janet_wrap_integer(INT32_MAX)));
assert(janet_equals(janet_wrap_integer(-2), janet_wrap_integer(-2)));
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
assert(janet_equals(janet_wrap_real(1.4), janet_wrap_real(1.4)));
assert(janet_equals(janet_wrap_real(3.14159265), janet_wrap_real(3.14159265)));
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));

10
examples/3sum.janet
View File

@ -5,10 +5,14 @@
(def solutions @{})
(def len (length s))
(for k 0 len
(put tab s@k k))
(put tab s.k k))
(for i 0 len
(for j 0 len
(def k (get tab (- 0 s@i s@j)))
(def k (get tab (- 0 s.i s.j)))
(when (and k (not= k i) (not= k j) (not= i j))
(put solutions {i true j true k true} true))))
(map keys (keys solution)))
(map keys (keys solutions)))
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
(print "3sum of " (string/pretty arr) ":")
(print (string/pretty (sum3 arr)))

2
examples/assembly.janet
View File

@ -13,7 +13,7 @@
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0)
(call 0 1) # $0 = call($1)
(addi 0 0 2) # $0 = $0 + $2 (integers)
(add 0 0 2) # $0 = $0 + $2 (integers)
:done
(ret 0) # return $0
]

4
examples/colors.janet
View File

@ -36,6 +36,6 @@
:bg-bright-white 107})
(loop [[name color] :in (pairs colormap)]
(defglobal (string.slice name 1)
(defglobal (string/slice name 1)
(fn color-wrapper [& pieces]
(string "\e[" color "m" (apply string pieces) "\e[0m"))))
(string "\e[" color "m" ;pieces "\e[0m"))))

6
examples/lazyseqs.janet
View File

@ -19,7 +19,7 @@
,state
(do
(set ,loaded true)
(set ,state (do ;forms)))))))
(set ,state (do ,;forms)))))))
# Use tuples instead of structs to save memory
(def- HEAD 0)
@ -52,7 +52,7 @@
(defn lazy-range
"Return a sequence of integers [start, end)."
@[start end]
[start end &]
(if end
(if (< start end)
(delay (tuple start (lazy-range (+ 1 start) end)))
@ -94,7 +94,7 @@
(defn randseq
"Return a sequence of random numbers."
[]
(delay (tuple (math.random) (randseq))))
(delay (tuple (math/random) (randseq))))
(defn take-while
"Returns a sequence of values until the predicate is false."

2
examples/primes.janet
View File

@ -12,3 +12,5 @@
(if (zero? (% i trial)) (set isprime? false)))
(if isprime? (array/push list i)))
list)
(print (string/pretty (primes 100)))

8
src/core/array.c
View File

@ -178,18 +178,14 @@ static int cfun_slice(JanetArgs args) {
/* Get start */
if (args.n < 2) {
start = 0;
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
start = janet_unwrap_integer(args.v[1]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(start, args, 1);
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
end = janet_unwrap_integer(args.v[2]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(end, args, 2);
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;

69
src/core/asm.c
View File

@ -62,9 +62,7 @@ struct JanetAssembler {
* prefix tree. */
static const JanetInstructionDef janet_ops[] = {
{"add", JOP_ADD},
{"addi", JOP_ADD_INTEGER},
{"addim", JOP_ADD_IMMEDIATE},
{"addr", JOP_ADD_REAL},
{"band", JOP_BAND},
{"bnot", JOP_BNOT},
{"bor", JOP_BOR},
@ -73,24 +71,17 @@ static const JanetInstructionDef janet_ops[] = {
{"clo", JOP_CLOSURE},
{"cmp", JOP_COMPARE},
{"div", JOP_DIVIDE},
{"divi", JOP_DIVIDE_INTEGER},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"divr", JOP_DIVIDE_REAL},
{"eq", JOP_EQUALS},
{"eqi", JOP_EQUALS_INTEGER},
{"eqim", JOP_EQUALS_IMMEDIATE},
{"eqn", JOP_NUMERIC_EQUAL},
{"eqr", JOP_EQUALS_REAL},
{"err", JOP_ERROR},
{"get", JOP_GET},
{"geti", JOP_GET_INDEX},
{"gt", JOP_GREATER_THAN},
{"gti", JOP_GREATER_THAN_INTEGER},
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
{"gtn", JOP_NUMERIC_GREATER_THAN},
{"gtr", JOP_GREATER_THAN_REAL},
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
{"gter", JOP_GREATER_THAN_EQUAL_REAL},
{"jmp", JOP_JUMP},
{"jmpif", JOP_JUMP_IF},
{"jmpno", JOP_JUMP_IF_NOT},
@ -104,11 +95,8 @@ static const JanetInstructionDef janet_ops[] = {
{"len", JOP_LENGTH},
{"lt", JOP_LESS_THAN},
{"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
{"lter", JOP_LESS_THAN_EQUAL_REAL},
{"lti", JOP_LESS_THAN_INTEGER},
{"ltim", JOP_LESS_THAN_IMMEDIATE},
{"ltn", JOP_NUMERIC_LESS_THAN},
{"ltr", JOP_LESS_THAN_REAL},
{"mkarr", JOP_MAKE_ARRAY},
{"mkbuf", JOP_MAKE_BUFFER},
{"mkstr", JOP_MAKE_STRING},
@ -118,9 +106,7 @@ static const JanetInstructionDef janet_ops[] = {
{"movf", JOP_MOVE_FAR},
{"movn", JOP_MOVE_NEAR},
{"mul", JOP_MULTIPLY},
{"muli", JOP_MULTIPLY_INTEGER},
{"mulim", JOP_MULTIPLY_IMMEDIATE},
{"mulr", JOP_MULTIPLY_REAL},
{"noop", JOP_NOOP},
{"push", JOP_PUSH},
{"push2", JOP_PUSH_2},
@ -162,10 +148,8 @@ static const TypeAlias type_aliases[] = {
{":fiber", JANET_TFLAG_FIBER},
{":function", JANET_TFLAG_FUNCTION},
{":indexed", JANET_TFLAG_INDEXED},
{":integer", JANET_TFLAG_INTEGER},
{":nil", JANET_TFLAG_NIL},
{":number", JANET_TFLAG_NUMBER},
{":real", JANET_TFLAG_REAL},
{":string", JANET_TFLAG_STRING},
{":struct", JANET_TFLAG_STRUCT},
{":symbol", JANET_TFLAG_SYMBOL},
@ -199,7 +183,7 @@ static void janet_asm_errorv(JanetAssembler *a, const uint8_t *m) {
/* Add a closure environment to the assembler. Sub funcdefs may need
* to reference outer function environments, and may change the outer environment.
* Returns the index of the environment in the assembler's environments, or -1
* if not found. */
* if not found. */
static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
Janet check;
JanetFuncDef *def = a->def;
@ -210,8 +194,8 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
}
/* Check for memoized value */
check = janet_table_get(&a->envs, envname);
if (janet_checktype(check, JANET_INTEGER)) {
return janet_unwrap_integer(check);
if (janet_checktype(check, JANET_NUMBER)) {
return (int32_t) janet_unwrap_number(check);
}
if (NULL == a->parent) return -2;
res = janet_asm_addenv(a->parent, envname);
@ -219,7 +203,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
return res;
}
envindex = def->environments_length;
janet_table_put(&a->envs, envname, janet_wrap_integer(envindex));
janet_table_put(&a->envs, envname, janet_wrap_number(envindex));
if (envindex >= a->environments_capacity) {
int32_t newcap = 2 * envindex;
def->environments = realloc(def->environments, newcap * sizeof(int32_t));
@ -265,9 +249,16 @@ static int32_t doarg_1(
default:
goto error;
break;
case JANET_INTEGER:
ret = janet_unwrap_integer(x);
case JANET_NUMBER:
{
double y = janet_unwrap_number(x);
if (y >= INT32_MIN && y <= INT32_MAX) {
ret = y;
} else {
goto error;
}
break;
}
case JANET_TUPLE:
{
const Janet *t = janet_unwrap_tuple(x);
@ -286,11 +277,11 @@ static int32_t doarg_1(
{
if (NULL != c) {
Janet result = janet_table_get(c, x);
if (janet_checktype(result, JANET_INTEGER)) {
if (janet_checktype(result, JANET_NUMBER)) {
if (argtype == JANET_OAT_LABEL) {
ret = janet_unwrap_integer(result) - a->bytecode_count;
} else {
ret = janet_unwrap_integer(result);
ret = (int32_t) janet_unwrap_number(result);
}
} else {
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
@ -469,7 +460,7 @@ static uint32_t read_instruction(
}
/* Helper to get from a structure */
static Janet janet_get(Janet ds, Janet key) {
static Janet janet_get1(Janet ds, Janet key) {
switch (janet_type(ds)) {
default:
return janet_wrap_nil();
@ -528,29 +519,29 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
"expected struct or table for assembly source");
/* Check for function name */
a.name = janet_get(s, janet_csymbolv("name"));
a.name = janet_get1(s, janet_csymbolv("name"));
if (!janet_checktype(a.name, JANET_NIL)) {
def->name = janet_to_string(a.name);
}
/* Set function arity */
x = janet_get(s, janet_csymbolv("arity"));
def->arity = janet_checktype(x, JANET_INTEGER) ? janet_unwrap_integer(x) : 0;
x = janet_get1(s, janet_csymbolv("arity"));
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
/* Check vararg */
x = janet_get(s, janet_csymbolv("vararg"));
x = janet_get1(s, janet_csymbolv("vararg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* Check strict arity */
x = janet_get(s, janet_csymbolv("fix-arity"));
x = janet_get1(s, janet_csymbolv("fix-arity"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
/* Check source */
x = janet_get(s, janet_csymbolv("source"));
x = janet_get1(s, janet_csymbolv("source"));
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
/* Create slot aliases */
x = janet_get(s, janet_csymbolv("slots"));
x = janet_get1(s, janet_csymbolv("slots"));
if (janet_indexed_view(x, &arr, &count)) {
for (i = 0; i < count; i++) {
Janet v = arr[i];
@ -571,7 +562,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Parse constants */
x = janet_get(s, janet_csymbolv("constants"));
x = janet_get1(s, janet_csymbolv("constants"));
if (janet_indexed_view(x, &arr, &count)) {
def->constants_length = count;
def->constants = malloc(sizeof(Janet) * count);
@ -606,7 +597,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Parse sub funcdefs */
x = janet_get(s, janet_csymbolv("closures"));
x = janet_get1(s, janet_csymbolv("closures"));
if (janet_indexed_view(x, &arr, &count)) {
int32_t i;
for (i = 0; i < count; i++) {
@ -617,7 +608,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
if (subres.status != JANET_ASSEMBLE_OK) {
janet_asm_errorv(&a, subres.error);
}
subname = janet_get(arr[i], janet_csymbolv("name"));
subname = janet_get1(arr[i], janet_csymbolv("name"));
if (!janet_checktype(subname, JANET_NIL)) {
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
}
@ -636,7 +627,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Parse bytecode and labels */
x = janet_get(s, janet_csymbolv("bytecode"));
x = janet_get1(s, janet_csymbolv("bytecode"));
if (janet_indexed_view(x, &arr, &count)) {
/* Do labels and find length */
int32_t blength = 0;
@ -692,7 +683,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
a.errindex = -1;
/* Check for source mapping */
x = janet_get(s, janet_csymbolv("sourcemap"));
x = janet_get1(s, janet_csymbolv("sourcemap"));
if (janet_indexed_view(x, &arr, &count)) {
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
def->sourcemap = malloc(sizeof(JanetSourceMapping) * count);
@ -704,10 +695,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
janet_asm_error(&a, "expected tuple");
}
tup = janet_unwrap_tuple(entry);
if (!janet_checktype(tup[0], JANET_INTEGER)) {
if (!janet_checkint(tup[0])) {
janet_asm_error(&a, "expected integer");
}
if (!janet_checktype(tup[1], JANET_INTEGER)) {
if (!janet_checkint(tup[1])) {
janet_asm_error(&a, "expected integer");
}
mapping.start = janet_unwrap_integer(tup[0]);

8
src/core/buffer.c
View File

@ -242,18 +242,14 @@ static int cfun_slice(JanetArgs args) {
/* Get start */
if (args.n < 2) {
start = 0;
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
start = janet_unwrap_integer(args.v[1]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(start, args, 1);
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
end = janet_unwrap_integer(args.v[2]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(end, args, 2);
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;

16
src/core/bytecode.c
View File

@ -30,20 +30,12 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_ST, /* JOP_TYPECHECK, */
JINT_S, /* JOP_RETURN, */
JINT_0, /* JOP_RETURN_NIL, */
JINT_SSS, /* JOP_ADD_INTEGER, */
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
JINT_SSS, /* JOP_ADD_REAL, */
JINT_SSS, /* JOP_ADD, */
JINT_SSS, /* JOP_SUBTRACT_INTEGER, */
JINT_SSS, /* JOP_SUBTRACT_REAL, */
JINT_SSS, /* JOP_SUBTRACT, */
JINT_SSS, /* JOP_MULTIPLY_INTEGER, */
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
JINT_SSS, /* JOP_MULTIPLY_REAL, */
JINT_SSS, /* JOP_MULTIPLY, */
JINT_SSS, /* JOP_DIVIDE_INTEGER, */
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
JINT_SSS, /* JOP_DIVIDE_REAL, */
JINT_SSS, /* JOP_DIVIDE, */
JINT_SSS, /* JOP_BAND, */
JINT_SSS, /* JOP_BOR, */
@ -61,19 +53,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_SL, /* JOP_JUMP_IF, */
JINT_SL, /* JOP_JUMP_IF_NOT, */
JINT_SSS, /* JOP_GREATER_THAN, */
JINT_SSS, /* JOP_GREATER_THAN_INTEGER, */
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
JINT_SSS, /* JOP_GREATER_THAN_REAL, */
JINT_SSS, /* JOP_GREATER_THAN_EQUAL_REAL, */
JINT_SSS, /* JOP_LESS_THAN, */
JINT_SSS, /* JOP_LESS_THAN_INTEGER, */
JINT_SSI, /* JOP_LESS_THAN_IMMEDIATE, */
JINT_SSS, /* JOP_LESS_THAN_REAL, */
JINT_SSS, /* JOP_LESS_THAN_EQUAL_REAL, */
JINT_SSS, /* JOP_EQUALS, */
JINT_SSS, /* JOP_EQUALS_INTEGER, */
JINT_SSI, /* JOP_EQUALS_IMMEDIATE, */
JINT_SSS, /* JOP_EQUALS_REAL, */
JINT_SSS, /* JOP_COMPARE, */
JINT_S, /* JOP_LOAD_NIL, */
JINT_S, /* JOP_LOAD_TRUE, */

6
src/core/core.janet
View File

@ -83,11 +83,7 @@
(defn pos? "Check if x is greater than 0." [x] (> x 0))
(defn neg? "Check if x is less than 0." [x] (< x 0))
(defn one? "Check if x is equal to 1." [x] (== x 1))
(defn integer? "Check if x is an integer." [x] (= (type x) :integer))
(defn real? "Check if x is a real number." [x] (= (type x) :real))
(defn number? "Check if x is a number." [x]
(def t (type x))
(if (= t :integer) true (= t :real)))
(defn number? "Check if x is a number." [x] (= (type x) :number))
(defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
(defn string? "Check if x is a string." [x] (= (type x) :string))
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))

54
src/core/corelib.c
View File

@ -156,39 +156,15 @@ static int janet_core_is_abstract(JanetArgs args) {
static int janet_core_scannumber(JanetArgs args) {
const uint8_t *data;
Janet x;
double val;
int status = 0;
int32_t len;
JANET_FIXARITY(args, 1);
JANET_ARG_BYTES(data, len, args, 0);
x = janet_scan_number(data, len);
JANET_RETURN(args, x);
}
static int janet_core_scaninteger(JanetArgs args) {
const uint8_t *data;
int32_t len, ret;
int err = 0;
JANET_FIXARITY(args, 1);
JANET_ARG_BYTES(data, len, args, 0);
ret = janet_scan_integer(data, len, &err);
if (err) {
JANET_RETURN_NIL(args);
}
JANET_RETURN_INTEGER(args, ret);
}
static int janet_core_scanreal(JanetArgs args) {
const uint8_t *data;
int32_t len;
double ret;
int err = 0;
JANET_FIXARITY(args, 1);
JANET_ARG_BYTES(data, len, args, 0);
ret = janet_scan_real(data, len, &err);
if (err) {
JANET_RETURN_NIL(args);
}
JANET_RETURN_REAL(args, ret);
val = janet_scan_number(data, len, &status);
if (status)
JANET_THROW(args, "failed to scan number");
JANET_RETURN_NUMBER(args, val);
}
static int janet_core_tuple(JanetArgs args) {
@ -348,18 +324,6 @@ static const JanetReg cfuns[] = {
"must be in the same format as numbers in janet source code. Will return nil "
"on an invalid number."
},
{"scan-integer", janet_core_scaninteger,
"(scan-integer str)\n\n"
"Parse an integer from a byte sequence an return that number. The integer "
"must be in the same format as integers in janet source code. Will return nil "
"on an invalid integer."
},
{"scan-real", janet_core_scanreal,
"(scan-real str)\n\n"
"Parse a real number from a byte sequence an return that number. The number "
"must be in the same format as numbers in janet source code. Will return nil "
"on an invalid number."
},
{"tuple", janet_core_tuple,
"(tuple & items)\n\n"
"Creates a new tuple that contains items. Returns the new tuple."
@ -502,7 +466,7 @@ static void templatize_varop(
SSS(JOP_GET, 4, 0, 5), /* operand = args[i] */
SSS(op, 3, 3, 4), /* accum = accum op operand */
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SSI(JOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
SSI(JOP_EQUALS, 2, 5, 1), /* jump? = (i == argn) */
SI(JOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
/* Done, do last and return accumulator */
@ -550,7 +514,7 @@ static void templatize_comparator(
SI(JOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */
SSI(JOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
SS(JOP_MOVE_NEAR, 3, 4), /* last = next */
SSI(JOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
SSI(JOP_EQUALS, 2, 5, 1), /* jump? = (i == argn) */
SI(JOP_JUMP_IF_NOT, 2, -6), /* if not jump? go back 6 */
/* Done, return true */
@ -592,7 +556,7 @@ static void make_apply(JanetTable *env) {
/* Main loop */
SSS(JOP_GET, 5, 1, 4), /* x = args[i] */
SSI(JOP_ADD_IMMEDIATE, 4, 4, 1), /* i++ */
SSI(JOP_EQUALS_INTEGER, 3, 4, 2), /* jump? = (i == argn) */
SSI(JOP_EQUALS, 3, 4, 2), /* jump? = (i == argn) */
SI(JOP_JUMP_IF, 3, 3), /* if jump? go forward 3 */
S(JOP_PUSH, 5),
(JOP_JUMP | ((uint32_t)(-5) << 8)),

20
src/core/emit.c
View File

@ -82,17 +82,17 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
case JANET_FALSE:
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
break;
case JANET_INTEGER:
case JANET_NUMBER:
{
int32_t i = janet_unwrap_integer(k);
if (i <= INT16_MAX && i >= INT16_MIN) {
janetc_emit(c,
(i << 16) |
(reg << 8) |
JOP_LOAD_INTEGER);
break;
}
goto do_constant;
double dval = janet_unwrap_number(k);
int32_t i = (int32_t) dval;
if (dval != i || !(dval >= INT16_MIN && dval <= INT16_MAX))
goto do_constant;
janetc_emit(c,
(i << 16) |
(reg << 8) |
JOP_LOAD_INTEGER);
break;
}
default:
do_constant:

6
src/core/gc.c
View File

@ -357,11 +357,9 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
case JANET_TRUE:
case JANET_FALSE:
case JANET_NIL:
case JANET_NUMBER:
/* These values don't really matter to the gc so returning 1 al the time is fine. */
return 1;
case JANET_INTEGER:
return janet_unwrap_integer(lhs) == janet_unwrap_integer(rhs);
case JANET_REAL:
return janet_unwrap_real(lhs) == janet_unwrap_real(rhs);
default:
return janet_unwrap_pointer(lhs) == janet_unwrap_pointer(rhs);
}

2
src/core/io.c
View File

@ -257,7 +257,7 @@ static int janet_io_fread(JanetArgs args) {
} else {
JANET_THROW(args, "expected one of :all, :line");
}
} else if (!janet_checktype(args.v[1], JANET_INTEGER)) {
} else if (!janet_checkint(args.v[1])) {
JANET_THROW(args, "expected positive integer");
} else {
int32_t len = janet_unwrap_integer(args.v[1]);

20
src/core/marsh.c
View File

@ -297,9 +297,15 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_TRUE:
pushbyte(st, 200 + type);
goto done;
case JANET_INTEGER:
pushint(st, janet_unwrap_integer(x));
goto done;
case JANET_NUMBER:
{
double xval = janet_unwrap_number(x);
if (janet_checkintrange(xval)) {
pushint(st, (int32_t) xval);
goto done;
}
break;
}
}
#define MARK_SEEN() \
@ -308,7 +314,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
/* Check reference and registry value */
{
Janet check = janet_table_get(&st->seen, x);
if (janet_checktype(check, JANET_INTEGER)) {
if (janet_checkint(check)) {
pushbyte(st, LB_REFERENCE);
pushint(st, janet_unwrap_integer(check));
goto done;
@ -328,13 +334,13 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
/* Reference types */
switch (type) {
case JANET_REAL:
case JANET_NUMBER:
{
union {
double d;
uint8_t bytes[8];
} u;
u.d = janet_unwrap_real(x);
u.d = janet_unwrap_number(x);
#ifdef JANET_BIG_ENDIAN
/* Swap byte order */
uint8_t temp;
@ -936,7 +942,7 @@ static const uint8_t *unmarshal_one(
#else
memcpy(&u.bytes, data + 1, sizeof(double));
#endif
*out = janet_wrap_real(u.d);
*out = janet_wrap_number(u.d);
janet_array_push(&st->lookup, *out);
return data + 9;
}

74
src/core/math.c
View File

@ -27,7 +27,7 @@
int janet_rand(JanetArgs args) {
JANET_FIXARITY(args, 0);
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
JANET_RETURN_REAL(args, r);
JANET_RETURN_NUMBER(args, r);
}
/* Seed the random number generator */
@ -39,52 +39,12 @@ int janet_srand(JanetArgs args) {
return 0;
}
/* Convert a number to an integer */
int janet_int(JanetArgs args) {
JANET_FIXARITY(args, 1);
switch (janet_type(args.v[0])) {
default:
JANET_THROW(args, "could not convert to integer");
case JANET_REAL:
*args.ret = janet_wrap_integer((int32_t) janet_unwrap_real(args.v[0]));
break;
case JANET_INTEGER:
*args.ret = args.v[0];
break;
}
return 0;
}
/* Convert a number to a real number */
int janet_real(JanetArgs args) {
JANET_FIXARITY(args, 1);
switch (janet_type(args.v[0])) {
default:
JANET_THROW(args, "could not convert to real");
case JANET_REAL:
*args.ret = args.v[0];
break;
case JANET_INTEGER:
*args.ret = janet_wrap_real((double) janet_unwrap_integer(args.v[0]));
break;
}
return 0;
}
int janet_remainder(JanetArgs args) {
JANET_FIXARITY(args, 2);
if (janet_checktype(args.v[0], JANET_INTEGER) &&
janet_checktype(args.v[1], JANET_INTEGER)) {
int32_t x, y;
x = janet_unwrap_integer(args.v[0]);
y = janet_unwrap_integer(args.v[1]);
JANET_RETURN_INTEGER(args, x % y);
} else {
double x, y;
JANET_ARG_NUMBER(x, args, 0);
JANET_ARG_NUMBER(y, args, 1);
JANET_RETURN_REAL(args, fmod(x, y));
}
double x, y;
JANET_ARG_NUMBER(x, args, 0);
JANET_ARG_NUMBER(y, args, 1);
JANET_RETURN_NUMBER(args, fmod(x, y));
}
#define JANET_DEFINE_MATHOP(name, fop)\
@ -92,7 +52,7 @@ int janet_##name(JanetArgs args) {\
double x;\
JANET_FIXARITY(args, 1);\
JANET_ARG_NUMBER(x, args, 0);\
JANET_RETURN_REAL(args, fop(x));\
JANET_RETURN_NUMBER(args, fop(x));\
}
JANET_DEFINE_MATHOP(acos, acos)
@ -118,7 +78,7 @@ int janet_##name(JanetArgs args) {\
JANET_FIXARITY(args, 2);\
JANET_ARG_NUMBER(lhs, args, 0);\
JANET_ARG_NUMBER(rhs, args, 1);\
JANET_RETURN_REAL(args, fop(lhs, rhs));\
JANET_RETURN_NUMBER(args, fop(lhs, rhs));\
}\
JANET_DEFINE_MATH2OP(atan2, atan2)
@ -137,15 +97,9 @@ static const JanetReg cfuns[] = {
{"not", janet_not,
"(not x)\n\nReturns the boolen inverse of x."
},
{"int", janet_int,
"(int x)\n\nCast a number x to an integer."
},
{"real", janet_real,
"(real x)\n\nCast a number x to a real number."
},
{"math/random", janet_rand,
"(math/random)\n\n"
"Returns a uniformly distrbuted random real number between 0 and 1."
"Returns a uniformly distrbuted random number number between 0 and 1."
},
{"math/seedrandom", janet_srand,
"(math/seedrandom seed)\n\n"
@ -194,11 +148,11 @@ static const JanetReg cfuns[] = {
},
{"math/floor", janet_floor,
"(math/floor x)\n\n"
"Returns the largest integer value real number that is not greater than x."
"Returns the largest integer value number number that is not greater than x."
},
{"math/ceil", janet_ceil,
"(math/ceil x)\n\n"
"Returns the smallest integer value real number that is not less than x."
"Returns the smallest integer value number number that is not less than x."
},
{"math/pow", janet_pow,
"(math/pow a x)\n\n"
@ -212,11 +166,11 @@ int janet_lib_math(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
janet_def(env, "math/pi", janet_wrap_real(3.1415926535897931),
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
"The value pi.");
janet_def(env, "math/e", janet_wrap_real(2.7182818284590451),
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
"The base of the natural log.");
janet_def(env, "math/inf", janet_wrap_real(INFINITY),
"The real number representing positive infinity");
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
"The number representing positive infinity");
return 0;
}

7
src/core/os.c
View File

@ -197,7 +197,7 @@ static int os_exit(JanetArgs args) {
JANET_MAXARITY(args, 1);
if (args.n == 0) {
exit(EXIT_SUCCESS);
} else if (janet_checktype(args.v[0], JANET_INTEGER)) {
} else if (janet_checkint(args.v[0])) {
exit(janet_unwrap_integer(args.v[0]));
} else {
exit(EXIT_FAILURE);
@ -208,7 +208,7 @@ static int os_exit(JanetArgs args) {
static int os_time(JanetArgs args) {
JANET_FIXARITY(args, 0);
double dtime = (double)(time(NULL));
JANET_RETURN_REAL(args, dtime);
JANET_RETURN_NUMBER(args, dtime);
}
/* Clock shims */
@ -244,7 +244,7 @@ static int os_clock(JanetArgs args) {
if (gettime(&tv))
JANET_THROW(args, "could not get time");
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
JANET_RETURN_REAL(args, dtime);
JANET_RETURN_NUMBER(args, dtime);
}
static int os_sleep(JanetArgs args) {
@ -326,7 +326,6 @@ static const JanetReg cfuns[] = {
"(os/sleep nsec)\n\n"
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
"nil."
},
{"os/cwd", os_cwd,
"(os/cwd)\n\n"

11
src/core/parse.c
View File

@ -279,8 +279,10 @@ static int check_str_const(const char *cstr, const uint8_t *str, int32_t len) {
}
static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
Janet numcheck, ret;
Janet ret;
double numval;
int32_t blen;
int scanerr;
if (is_symbol_char(c)) {
push_buf(p, (uint8_t) c);
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
@ -288,9 +290,10 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
}
/* Token finished */
blen = (int32_t) p->bufcount;
numcheck = janet_scan_number(p->buf, blen);
if (!janet_checktype(numcheck, JANET_NIL)) {
ret = numcheck;
scanerr = 0;
numval = janet_scan_number(p->buf, blen, &scanerr);
if (!scanerr) {
ret = janet_wrap_number(numval);
} else if (!check_str_const("nil", p->buf, blen)) {
ret = janet_wrap_nil();
} else if (!check_str_const("false", p->buf, blen)) {

49
src/core/string.c
View File

@ -106,19 +106,19 @@ const uint8_t *janet_cstring(const char *str) {
/* Temporary buffer size */
#define BUFSIZE 64
static int32_t real_to_string_impl(uint8_t *buf, double x) {
int count = snprintf((char *) buf, BUFSIZE, "%.17gr", x);
static int32_t number_to_string_impl(uint8_t *buf, double x) {
int count = snprintf((char *) buf, BUFSIZE, "%.17g", x);
return (int32_t) count;
}
static void real_to_string_b(JanetBuffer *buffer, double x) {
static void number_to_string_b(JanetBuffer *buffer, double x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
buffer->count += real_to_string_impl(buffer->data + buffer->count, x);
buffer->count += number_to_string_impl(buffer->data + buffer->count, x);
}
static const uint8_t *real_to_string(double x) {
static const uint8_t *number_to_string(double x) {
uint8_t buf[BUFSIZE];
return janet_string(buf, real_to_string_impl(buf, x));
return janet_string(buf, number_to_string_impl(buf, x));
}
/* expects non positive x */
@ -161,11 +161,6 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
buffer->count += integer_to_string_impl(buffer->data + buffer->count, x);
}
static const uint8_t *integer_to_string(int32_t x) {
uint8_t buf[BUFSIZE];
return janet_string(buf, integer_to_string_impl(buf, x));
}
#define HEX(i) (((uint8_t *) janet_base64)[(i)])
/* Returns a string description for a pointer. Truncates
@ -322,11 +317,8 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
case JANET_FALSE:
janet_buffer_push_cstring(buffer, "false");
return;
case JANET_REAL:
real_to_string_b(buffer, janet_unwrap_real(x));
return;
case JANET_INTEGER:
integer_to_string_b(buffer, janet_unwrap_integer(x));
case JANET_NUMBER:
number_to_string_b(buffer, janet_unwrap_number(x));
return;
case JANET_SYMBOL:
janet_buffer_push_bytes(buffer,
@ -407,10 +399,8 @@ const uint8_t *janet_description(Janet x) {
return janet_cstring("true");
case JANET_FALSE:
return janet_cstring("false");
case JANET_REAL:
return real_to_string(janet_unwrap_real(x));
case JANET_INTEGER:
return integer_to_string(janet_unwrap_integer(x));
case JANET_NUMBER:
return number_to_string(janet_unwrap_number(x));
case JANET_SYMBOL:
return janet_unwrap_symbol(x);
case JANET_STRING:
@ -494,8 +484,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
/* Add to seen */
switch (janet_type(x)) {
case JANET_NIL:
case JANET_INTEGER:
case JANET_REAL:
case JANET_NUMBER:
case JANET_SYMBOL:
case JANET_TRUE:
case JANET_FALSE:
@ -503,7 +492,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
default:
{
Janet seenid = janet_table_get(&S->seen, x);
if (janet_checktype(seenid, JANET_INTEGER)) {
if (janet_checktype(seenid, JANET_NUMBER)) {
janet_buffer_push_cstring(S->buffer, "<cycle ");
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
janet_buffer_push_u8(S->buffer, '>');
@ -652,7 +641,7 @@ const uint8_t *janet_formatc(const char *format, ...) {
janet_buffer_push_u8(bufp, format[i]);
break;
case 'f':
real_to_string_b(bufp, va_arg(args, double));
number_to_string_b(bufp, va_arg(args, double));
break;
case 'd':
integer_to_string_b(bufp, va_arg(args, int32_t));
@ -803,18 +792,14 @@ static int cfun_slice(JanetArgs args) {
/* Get start */
if (args.n < 2) {
start = 0;
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
start = janet_unwrap_integer(args.v[1]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(start, args, 1);
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
end = janet_unwrap_integer(args.v[2]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(end, args, 2);
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;
@ -870,7 +855,9 @@ static int cfun_frombytes(JanetArgs args) {
int32_t i;
uint8_t *buf;
for (i = 0; i < args.n; i++) {
JANET_CHECK(args, i, JANET_INTEGER);
if (!janet_checkint(args.v[i])) {
JANET_THROW(args, "expected integer byte values");
}
}
buf = janet_string_begin(args.n);
for (i = 0; i < args.n; i++) {

20
src/core/strtod.c
View File

@ -295,7 +295,7 @@ int32_t janet_scan_integer(
/* Scan a real (double) from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
double janet_scan_real(
double janet_scan_number(
const uint8_t *str,
int32_t len,
int *err) {
@ -310,21 +310,3 @@ double janet_scan_real(
}
return convert(res.neg, res.mant, res.base, res.ex);
}
/* Scans a number from a string. Can return either an integer or a real if
* the number cannot be represented as an integer. Will return nil in case of
* an error. */
Janet janet_scan_number(
const uint8_t *str,
int32_t len) {
struct JanetScanRes res = janet_scan_impl(str, len);
if (res.error)
return janet_wrap_nil();
if (!res.foundexp && !res.seenpoint) {
int64_t i64 = res.neg ? -(int64_t)res.mant : (int64_t)res.mant;
if (i64 <= INT32_MAX && i64 >= INT32_MIN) {
return janet_wrap_integer((int32_t) i64);
}
}
return janet_wrap_real(convert(res.neg, res.mant, res.base, res.ex));
}

8
src/core/tuple.c
View File

@ -101,18 +101,14 @@ static int cfun_slice(JanetArgs args) {
/* Get start */
if (args.n < 2) {
start = 0;
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
start = janet_unwrap_integer(args.v[1]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(start, args, 1);
}
/* Get end */
if (args.n < 3) {
end = -1;
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
end = janet_unwrap_integer(args.v[2]);
} else {
JANET_THROW(args, "expected integer");
JANET_ARG_INTEGER(end, args, 2);
}
if (start < 0) start = len + start;
if (end < 0) end = len + end + 1;

19
src/core/util.c
View File

@ -34,13 +34,12 @@ const char janet_base64[65] =
/* The JANET value types in order. These types can be used as
* mnemonics instead of a bit pattern for type checking */
const char *const janet_type_names[16] = {
const char *const janet_type_names[15] = {
":nil",
":boolean",
":boolean",
":fiber",
":integer",
":real",
":number",
":string",
":symbol",
":array",
@ -423,3 +422,17 @@ int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *a
"bad slot #%d, expected %s, got %s",
n, at->name, typestr(args, n))));
}
int janet_checkint(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkintrange(dval);
}
int janet_checkint64(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkint64range(dval);
}

249
src/core/value.c
View File

@ -38,11 +38,8 @@ int janet_equals(Janet x, Janet y) {
case JANET_FALSE:
result = 1;
break;
case JANET_REAL:
result = (janet_unwrap_real(x) == janet_unwrap_real(y));
break;
case JANET_INTEGER:
result = (janet_unwrap_integer(x) == janet_unwrap_integer(y));
case JANET_NUMBER:
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
break;
case JANET_STRING:
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
@ -85,9 +82,6 @@ int32_t janet_hash(Janet x) {
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
break;
case JANET_INTEGER:
hash = janet_unwrap_integer(x);
break;
default:
/* TODO - test performance with different hash functions */
if (sizeof(double) == sizeof(void *)) {
@ -117,25 +111,19 @@ int janet_compare(Janet x, Janet y) {
case JANET_FALSE:
case JANET_TRUE:
return 0;
case JANET_REAL:
case JANET_NUMBER:
/* Check for nans to ensure total order */
if (janet_unwrap_real(x) != janet_unwrap_real(x))
return janet_unwrap_real(y) != janet_unwrap_real(y)
if (janet_unwrap_number(x) != janet_unwrap_number(x))
return janet_unwrap_number(y) != janet_unwrap_number(y)
? 0
: -1;
if (janet_unwrap_real(y) != janet_unwrap_real(y))
if (janet_unwrap_number(y) != janet_unwrap_number(y))
return 1;
if (janet_unwrap_real(x) == janet_unwrap_real(y)) {
if (janet_unwrap_number(x) == janet_unwrap_number(y)) {
return 0;
} else {
return janet_unwrap_real(x) > janet_unwrap_real(y) ? 1 : -1;
}
case JANET_INTEGER:
if (janet_unwrap_integer(x) == janet_unwrap_integer(y)) {
return 0;
} else {
return janet_unwrap_integer(x) > janet_unwrap_integer(y) ? 1 : -1;
return janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1;
}
case JANET_STRING:
case JANET_SYMBOL:
@ -154,3 +142,224 @@ int janet_compare(Janet x, Janet y) {
}
return (janet_type(x) < janet_type(y)) ? -1 : 1;
}
/* Gets a value and returns. If successful, return 0. If there is an error,
* returns -1 for bad ds, -2 for bad key */
int janet_get(Janet ds, Janet key, Janet *out) {
Janet value;
switch (janet_type(ds)) {
default:
return -1;
case JANET_STRUCT:
value = janet_struct_get(janet_unwrap_struct(ds), key);
break;
case JANET_TABLE:
value = janet_table_get(janet_unwrap_table(ds), key);
break;
case JANET_ARRAY:
{
JanetArray *array = janet_unwrap_array(ds);
int32_t index;
if (!janet_checkint(key)) return -2;
index = janet_unwrap_integer(key);
if (index < 0 || index >= array->count) {
value = janet_wrap_nil();
} else {
value = array->data[index];
}
break;
}
case JANET_TUPLE:
{
const Janet *tuple = janet_unwrap_tuple(ds);
int32_t index;
if (!janet_checkint(key)) return -2;
index = janet_unwrap_integer(key);
if (index < 0 || index >= janet_tuple_length(tuple)) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = tuple[index];
}
break;
}
case JANET_BUFFER:
{
JanetBuffer *buffer = janet_unwrap_buffer(ds);
int32_t index;
if (!janet_checkint(key)) return -2;
index = janet_unwrap_integer(key);
if (index < 0 || index >= buffer->count) {
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(buffer->data[index]);
}
break;
}
case JANET_STRING:
case JANET_SYMBOL:
{
const uint8_t *str = janet_unwrap_string(ds);
int32_t index;
if (!janet_checkint(key)) return -2;
index = janet_unwrap_integer(key);
if (index < 0 || index >= janet_string_length(str)) {
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(str[index]);
}
break;
}
}
*out = value;
return 0;
}
int janet_getindex(Janet ds, int32_t index, Janet *out) {
Janet value;
if (index < 0)
return -2;
switch (janet_type(ds)) {
default:
return -1;
case JANET_STRING:
case JANET_SYMBOL:
if (index >= janet_string_length(janet_unwrap_string(ds))) {
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(janet_unwrap_string(ds)[index]);
}
break;
case JANET_ARRAY:
if (index >= janet_unwrap_array(ds)->count) {
value = janet_wrap_nil();
} else {
value = janet_unwrap_array(ds)->data[index];
}
break;
case JANET_BUFFER:
if (index >= janet_unwrap_buffer(ds)->count) {
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(janet_unwrap_buffer(ds)->data[index]);
}
break;
case JANET_TUPLE:
if (index >= janet_tuple_length(janet_unwrap_tuple(ds))) {
value = janet_wrap_nil();
} else {
value = janet_unwrap_tuple(ds)[index];
}
break;
case JANET_TABLE:
value = janet_table_get(janet_unwrap_table(ds), janet_wrap_integer(index));
break;
case JANET_STRUCT:
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
break;
}
*out = value;
return 0;
}
int janet_length(Janet x, int32_t *out) {
int32_t len;
switch (janet_type(x)) {
default:
return -1;
case JANET_STRING:
case JANET_SYMBOL:
len = janet_string_length(janet_unwrap_string(x));
break;
case JANET_ARRAY:
len = janet_unwrap_array(x)->count;
break;
case JANET_BUFFER:
len = janet_unwrap_buffer(x)->count;
break;
case JANET_TUPLE:
len = janet_tuple_length(janet_unwrap_tuple(x));
break;
case JANET_STRUCT:
len = janet_struct_length(janet_unwrap_struct(x));
break;
case JANET_TABLE:
len = janet_unwrap_table(x)->count;
break;
}
*out = len;
return 0;
}
int janet_putindex(Janet ds, int32_t index, Janet value) {
switch (janet_type(ds)) {
default:
return -1;
case JANET_ARRAY:
{
JanetArray *array = janet_unwrap_array(ds);
if (index >= array->count) {
janet_array_ensure(array, index + 1, 2);
array->count = index + 1;
}
array->data[index] = value;
break;
}
case JANET_BUFFER:
{
JanetBuffer *buffer = janet_unwrap_buffer(ds);
if (!janet_checkint(value)) return -3;
if (index >= buffer->count) {
janet_buffer_ensure(buffer, index + 1, 2);
buffer->count = index + 1;
}
buffer->data[index] = janet_unwrap_integer(value);
break;
}
case JANET_TABLE:
{
JanetTable *table = janet_unwrap_table(ds);
janet_table_put(table, janet_wrap_integer(index), value);
break;
}
}
return 0;
}
int janet_put(Janet ds, Janet key, Janet value) {
switch (janet_type(ds)) {
default:
return -1;
case JANET_ARRAY:
{
int32_t index;
JanetArray *array = janet_unwrap_array(ds);
if (!janet_checkint(key)) return -2;
index = janet_unwrap_integer(key);
if (index < 0 || index == INT32_MAX) return -2;
if (index >= array->count) {
janet_array_setcount(array, index + 1);
}
array->data[index] = value;
break;
}
case JANET_BUFFER:
{
int32_t index;
JanetBuffer *buffer = janet_unwrap_buffer(ds);
if (!janet_checkint(key)) return -2;
index = janet_unwrap_integer(key);
if (index < 0 || index == INT32_MAX) return -2;
if (!janet_checkint(value)) return -3;
if (index >= buffer->count) {
janet_buffer_setcount(buffer, index + 1);
}
buffer->data[index] = (uint8_t) (janet_unwrap_integer(value) & 0xFF);
break;
}
case JANET_TABLE:
janet_table_put(janet_unwrap_table(ds), key, value);
break;
}
return 0;
}

513
src/core/vm.c
View File

@ -122,20 +122,12 @@ static void *op_lookup[255] = {
&&label_JOP_TYPECHECK,
&&label_JOP_RETURN,
&&label_JOP_RETURN_NIL,
&&label_JOP_ADD_INTEGER,
&&label_JOP_ADD_IMMEDIATE,
&&label_JOP_ADD_REAL,
&&label_JOP_ADD,
&&label_JOP_SUBTRACT_INTEGER,
&&label_JOP_SUBTRACT_REAL,
&&label_JOP_SUBTRACT,
&&label_JOP_MULTIPLY_INTEGER,
&&label_JOP_MULTIPLY_IMMEDIATE,
&&label_JOP_MULTIPLY_REAL,
&&label_JOP_MULTIPLY,
&&label_JOP_DIVIDE_INTEGER,
&&label_JOP_DIVIDE_IMMEDIATE,
&&label_JOP_DIVIDE_REAL,
&&label_JOP_DIVIDE,
&&label_JOP_BAND,
&&label_JOP_BOR,
@ -153,19 +145,11 @@ static void *op_lookup[255] = {
&&label_JOP_JUMP_IF,
&&label_JOP_JUMP_IF_NOT,
&&label_JOP_GREATER_THAN,
&&label_JOP_GREATER_THAN_INTEGER,
&&label_JOP_GREATER_THAN_IMMEDIATE,
&&label_JOP_GREATER_THAN_REAL,
&&label_JOP_GREATER_THAN_EQUAL_REAL,
&&label_JOP_LESS_THAN,
&&label_JOP_LESS_THAN_INTEGER,
&&label_JOP_LESS_THAN_IMMEDIATE,
&&label_JOP_LESS_THAN_REAL,
&&label_JOP_LESS_THAN_EQUAL_REAL,
&&label_JOP_EQUALS,
&&label_JOP_EQUALS_INTEGER,
&&label_JOP_EQUALS_IMMEDIATE,
&&label_JOP_EQUALS_REAL,
&&label_JOP_COMPARE,
&&label_JOP_LOAD_NIL,
&&label_JOP_LOAD_TRUE,
@ -229,61 +213,63 @@ static void *op_lookup[255] = {
} \
} while (0)
#define vm_binop_integer(op) \
stack[oparg(1, 0xFF)] = janet_wrap_integer(\
janet_unwrap_integer(stack[oparg(2, 0xFF)]) op janet_unwrap_integer(stack[oparg(3, 0xFF)])\
);\
pc++;\
vm_next();
#define vm_binop_real(op)\
stack[oparg(1, 0xFF)] = janet_wrap_real(\
janet_unwrap_real(stack[oparg(2, 0xFF)]) op janet_unwrap_real(stack[oparg(3, 0xFF)])\
);\
pc++;\
vm_next();
#define vm_binop_immediate(op)\
stack[oparg(1, 0xFF)] = janet_wrap_integer(\
janet_unwrap_integer(stack[oparg(2, 0xFF)]) op (*((int32_t *)pc) >> 24)\
);\
pc++;\
vm_next();
#define vm_binop(op)\
{\
Janet op1 = stack[oparg(2, 0xFF)];\
Janet op2 = stack[oparg(3, 0xFF)];\
vm_assert_types(op1, JANET_TFLAG_NUMBER);\
vm_assert_types(op2, JANET_TFLAG_NUMBER);\
stack[oparg(1, 0xFF)] = janet_checktype(op1, JANET_INTEGER)\
? (janet_checktype(op2, JANET_INTEGER)\
? janet_wrap_integer(janet_unwrap_integer(op1) op janet_unwrap_integer(op2))\
: janet_wrap_real((double)janet_unwrap_integer(op1) op janet_unwrap_real(op2)))\
: (janet_checktype(op2, JANET_INTEGER)\
? janet_wrap_real(janet_unwrap_real(op1) op (double)janet_unwrap_integer(op2))\
: janet_wrap_real(janet_unwrap_real(op1) op janet_unwrap_real(op2)));\
vm_assert_type(op1, JANET_NUMBER);\
double x1 = janet_unwrap_number(op1);\
int32_t x2 = (*((int32_t *)pc) >> 24);\
stack[oparg(1, 0xFF)] = janet_wrap_number(x1 op x2);\
pc++;\
vm_next();\
}
#define vm_numcomp(op)\
#define _vm_bitop_immediate(op, type1)\
{\
Janet op1 = stack[oparg(2, 0xFF)];\
Janet op2 = stack[oparg(3, 0xFF)];\
vm_assert_types(op1, JANET_TFLAG_NUMBER);\
vm_assert_types(op2, JANET_TFLAG_NUMBER);\
stack[oparg(1, 0xFF)] = janet_wrap_boolean(janet_checktype(op1, JANET_INTEGER)\
? (janet_checktype(op2, JANET_INTEGER)\
? janet_unwrap_integer(op1) op janet_unwrap_integer(op2)\
: (double)janet_unwrap_integer(op1) op janet_unwrap_real(op2))\
: (janet_checktype(op2, JANET_INTEGER)\
? janet_unwrap_real(op1) op (double)janet_unwrap_integer(op2)\
: janet_unwrap_real(op1) op janet_unwrap_real(op2)));\
vm_assert_type(op1, JANET_NUMBER);\
type1 x1 = (type1) janet_unwrap_integer(op1);\
int32_t x2 = (*((int32_t *)pc) >> 24);\
stack[oparg(1, 0xFF)] = janet_wrap_integer(x1 op x2);\
pc++;\
vm_next();\
}
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
#define _vm_binop(op, wrap)\
{\
Janet op1 = stack[oparg(2, 0xFF)];\
Janet op2 = stack[oparg(3, 0xFF)];\
vm_assert_type(op1, JANET_NUMBER);\
vm_assert_type(op2, JANET_NUMBER);\
double x1 = janet_unwrap_number(op1);\
double x2 = janet_unwrap_number(op2);\
stack[oparg(1, 0xFF)] = wrap(x1 op x2);\
pc++;\
vm_next();\
}
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
#define _vm_bitop(op, type1)\
{\
Janet op1 = stack[oparg(2, 0xFF)];\
Janet op2 = stack[oparg(3, 0xFF)];\
vm_assert_type(op1, JANET_NUMBER);\
vm_assert_type(op2, JANET_NUMBER);\
type1 x1 = (type1) janet_unwrap_integer(op1);\
int32_t x2 = janet_unwrap_integer(op2);\
stack[oparg(1, 0xFF)] = janet_wrap_integer(x1 op x2);\
pc++;\
vm_next();\
}
#define vm_bitop(op) _vm_bitop(op, int32_t)
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
/* Main interpreter loop. Semantically is a switch on
* (*pc & 0xFF) inside of an infinte loop. */
VM_START();
@ -320,36 +306,18 @@ static void *op_lookup[255] = {
retreg = janet_wrap_nil();
goto vm_return;
VM_OP(JOP_ADD_INTEGER)
vm_binop_integer(+);
VM_OP(JOP_ADD_IMMEDIATE)
vm_binop_immediate(+);
VM_OP(JOP_ADD_REAL)
vm_binop_real(+);
VM_OP(JOP_ADD)
vm_binop(+);
VM_OP(JOP_SUBTRACT_INTEGER)
vm_binop_integer(-);
VM_OP(JOP_SUBTRACT_REAL)
vm_binop_real(-);
VM_OP(JOP_SUBTRACT)
vm_binop(-);
VM_OP(JOP_MULTIPLY_INTEGER)
vm_binop_integer(*);
VM_OP(JOP_MULTIPLY_IMMEDIATE)
vm_binop_immediate(*);
VM_OP(JOP_MULTIPLY_REAL)
vm_binop_real(*);
VM_OP(JOP_MULTIPLY)
vm_binop(*);
@ -368,104 +336,47 @@ static void *op_lookup[255] = {
VM_OP(JOP_NUMERIC_EQUAL)
vm_numcomp(==);
VM_OP(JOP_DIVIDE_INTEGER)
vm_assert(janet_unwrap_integer(stack[oparg(3, 0xFF)]) != 0, "integer divide error");
vm_assert(!(janet_unwrap_integer(stack[oparg(3, 0xFF)]) == -1 &&
janet_unwrap_integer(stack[oparg(2, 0xFF)]) == INT32_MIN),
"integer divide error");
vm_binop_integer(/);
VM_OP(JOP_DIVIDE_IMMEDIATE)
{
int32_t op1 = janet_unwrap_integer(stack[oparg(2, 0xFF)]);
int32_t op2 = *((int32_t *)pc) >> 24;
/* Check for degenerate integer division (divide by zero, and dividing
* min value by -1). These checks could be omitted if the arg is not
* 0 or -1. */
if (op2 == 0)
vm_throw("integer divide error");
if (op2 == -1 && op1 == INT32_MIN)
vm_throw("integer divide error");
else
stack[oparg(1, 0xFF)] = janet_wrap_integer(op1 / op2);
pc++;
vm_next();
}
VM_OP(JOP_DIVIDE_REAL)
vm_binop_real(/);
vm_binop_immediate(/);
VM_OP(JOP_DIVIDE)
vm_binop(/);
VM_OP(JOP_BAND)
vm_bitop(&);
VM_OP(JOP_BOR)
vm_bitop(|);
VM_OP(JOP_BXOR)
vm_bitop(^);
VM_OP(JOP_BNOT)
{
Janet op1 = stack[oparg(2, 0xFF)];
Janet op2 = stack[oparg(3, 0xFF)];
vm_assert_types(op1, JANET_TFLAG_NUMBER);
vm_assert_types(op2, JANET_TFLAG_NUMBER);
if (janet_checktype(op2, JANET_INTEGER) && janet_unwrap_integer(op2) == 0)
vm_throw("integer divide by zero");
if (janet_checktype(op2, JANET_INTEGER) && janet_unwrap_integer(op2) == -1 &&
janet_checktype(op1, JANET_INTEGER) && janet_unwrap_integer(op1) == INT32_MIN)
vm_throw("integer divide out of range");
stack[oparg(1, 0xFF)] = janet_checktype(op1, JANET_INTEGER)
? (janet_checktype(op2, JANET_INTEGER)
? janet_wrap_integer(janet_unwrap_integer(op1) / janet_unwrap_integer(op2))
: janet_wrap_real((double)janet_unwrap_integer(op1) / janet_unwrap_real(op2)))
: (janet_checktype(op2, JANET_INTEGER)
? janet_wrap_real(janet_unwrap_real(op1) / (double)janet_unwrap_integer(op2))
: janet_wrap_real(janet_unwrap_real(op1) / janet_unwrap_real(op2)));
pc++;
Janet op = stack[oparg(2, 0xFFFF)];
vm_assert_type(op, JANET_NUMBER);
stack[oparg(1, 0xFF)] = janet_wrap_integer(~janet_unwrap_integer(op));
++pc;
vm_next();
}
VM_OP(JOP_BAND)
vm_binop_integer(&);
VM_OP(JOP_BOR)
vm_binop_integer(|);
VM_OP(JOP_BXOR)
vm_binop_integer(^);
VM_OP(JOP_BNOT)
stack[oparg(1, 0xFF)] = janet_wrap_integer(~janet_unwrap_integer(stack[oparg(2, 0xFFFF)]));
++pc;
vm_next();
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
stack[oparg(1, 0xFF)] = janet_wrap_integer(
(int32_t)(((uint32_t)janet_unwrap_integer(stack[oparg(2, 0xFF)]))
>>
janet_unwrap_integer(stack[oparg(3, 0xFF)]))
);
pc++;
vm_next();
vm_bitopu(>>);
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE)
stack[oparg(1, 0xFF)] = janet_wrap_integer(
(int32_t) (((uint32_t)janet_unwrap_integer(stack[oparg(2, 0xFF)])) >> oparg(3, 0xFF))
);
pc++;
vm_next();
vm_bitopu_immediate(>>);
VM_OP(JOP_SHIFT_RIGHT)
vm_binop_integer(>>);
vm_bitop(>>);
VM_OP(JOP_SHIFT_RIGHT_IMMEDIATE)
stack[oparg(1, 0xFF)] = janet_wrap_integer(
(int32_t)(janet_unwrap_integer(stack[oparg(2, 0xFF)]) >> oparg(3, 0xFF))
);
pc++;
vm_next();
vm_bitop_immediate(>>);
VM_OP(JOP_SHIFT_LEFT)
vm_binop_integer(<<);
vm_bitop(<<);
VM_OP(JOP_SHIFT_LEFT_IMMEDIATE)
stack[oparg(1, 0xFF)] = janet_wrap_integer(
janet_unwrap_integer(stack[oparg(2, 0xFF)]) << oparg(3, 0xFF)
);
pc++;
vm_next();
vm_bitop_immediate(<<);
VM_OP(JOP_MOVE_NEAR)
stack[oparg(1, 0xFF)] = stack[oparg(2, 0xFFFF)];
@ -505,14 +416,6 @@ static void *op_lookup[255] = {
pc++;
vm_next();
/* Candidate */
VM_OP(JOP_LESS_THAN_INTEGER)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_integer(stack[oparg(2, 0xFF)]) <
janet_unwrap_integer(stack[oparg(3, 0xFF)]));
pc++;
vm_next();
/* Candidate */
VM_OP(JOP_LESS_THAN_IMMEDIATE)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
@ -521,23 +424,6 @@ static void *op_lookup[255] = {
pc++;
vm_next();
/* Candidate */
VM_OP(JOP_LESS_THAN_REAL)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_real(stack[oparg(2, 0xFF)]) <
janet_unwrap_real(stack[oparg(3, 0xFF)]));
pc++;
vm_next();
/* Candidate */
VM_OP(JOP_LESS_THAN_EQUAL_REAL)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_real(stack[oparg(2, 0xFF)]) <=
janet_unwrap_real(stack[oparg(3, 0xFF)]));
pc++;
vm_next();
VM_OP(JOP_GREATER_THAN)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(janet_compare(
stack[oparg(2, 0xFF)],
@ -546,13 +432,6 @@ static void *op_lookup[255] = {
pc++;
vm_next();
VM_OP(JOP_GREATER_THAN_INTEGER)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_integer(stack[oparg(2, 0xFF)]) >
janet_unwrap_integer(stack[oparg(3, 0xFF)]));
pc++;
vm_next();
VM_OP(JOP_GREATER_THAN_IMMEDIATE)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_integer(stack[oparg(2, 0xFF)]) > ((*(int32_t *)pc) >> 24)
@ -560,20 +439,6 @@ static void *op_lookup[255] = {
pc++;
vm_next();
VM_OP(JOP_GREATER_THAN_REAL)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_real(stack[oparg(2, 0xFF)]) >
janet_unwrap_real(stack[oparg(3, 0xFF)]));
pc++;
vm_next();
VM_OP(JOP_GREATER_THAN_EQUAL_REAL)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_real(stack[oparg(2, 0xFF)]) >=
janet_unwrap_real(stack[oparg(3, 0xFF)]));
pc++;
vm_next();
VM_OP(JOP_EQUALS)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(janet_equals(
stack[oparg(2, 0xFF)],
@ -582,22 +447,6 @@ static void *op_lookup[255] = {
pc++;
vm_next();
VM_OP(JOP_EQUALS_INTEGER)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_integer(stack[oparg(2, 0xFF)]) ==
janet_unwrap_integer(stack[oparg(3, 0xFF)])
);
pc++;
vm_next();
VM_OP(JOP_EQUALS_REAL)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_real(stack[oparg(2, 0xFF)]) ==
janet_unwrap_real(stack[oparg(3, 0xFF)])
);
pc++;
vm_next();
VM_OP(JOP_EQUALS_IMMEDIATE)
stack[oparg(1, 0xFF)] = janet_wrap_boolean(
janet_unwrap_integer(stack[oparg(2, 0xFF)]) == ((*(int32_t *)pc) >> 24)
@ -792,7 +641,7 @@ static void *op_lookup[255] = {
VM_OP(JOP_TAILCALL)
{
Janet callee = stack[oparg(1, 0xFFFFFF)];
Janet callee = stack[oparg(1, 0xFFFF)];
if (janet_checktype(callee, JANET_FUNCTION)) {
func = janet_unwrap_function(callee);
if (janet_fiber_funcframe_tail(fiber, func))
@ -842,47 +691,17 @@ static void *op_lookup[255] = {
Janet ds = stack[oparg(1, 0xFF)];
Janet key = stack[oparg(2, 0xFF)];
Janet value = stack[oparg(3, 0xFF)];
switch (janet_type(ds)) {
default:
int status;
if ((status = janet_put(ds, key, value))) {
if (status == -1) {
expected_types = JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE;
retreg = ds;
goto vm_type_error;
case JANET_ARRAY:
{
int32_t index;
JanetArray *array = janet_unwrap_array(ds);
vm_assert_type(key, JANET_INTEGER);
if (janet_unwrap_integer(key) < 0)
vm_throw("expected non-negative integer key");
index = janet_unwrap_integer(key);
if (index == INT32_MAX)
vm_throw("key too large");
if (index >= array->count) {
janet_array_setcount(array, index + 1);
}
array->data[index] = value;
break;
} else if (status == -2) {
vm_throw("expected integer key for data structure");
} else if (status == -3) {
vm_throw("expected integer value for data structure");
}
case JANET_BUFFER:
{
int32_t index;
JanetBuffer *buffer = janet_unwrap_buffer(ds);
vm_assert_type(key, JANET_INTEGER);
if (janet_unwrap_integer(key) < 0)
vm_throw("expected non-negative integer key");
index = janet_unwrap_integer(key);
if (index == INT32_MAX)
vm_throw("key too large");
vm_assert_type(value, JANET_INTEGER);
if (index >= buffer->count) {
janet_buffer_setcount(buffer, index + 1);
}
buffer->data[index] = (uint8_t) (janet_unwrap_integer(value) & 0xFF);
break;
}
case JANET_TABLE:
janet_table_put(janet_unwrap_table(ds), key, value);
break;
}
++pc;
vm_checkgc_next();
@ -893,32 +712,15 @@ static void *op_lookup[255] = {
Janet ds = stack[oparg(1, 0xFF)];
Janet value = stack[oparg(2, 0xFF)];
int32_t index = oparg(3, 0xFF);
switch (janet_type(ds)) {
default:
expected_types = JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER;
int status;
if ((status = janet_putindex(ds, index, value))) {
if (status == -1) {
expected_types = JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE;
retreg = ds;
goto vm_type_error;
case JANET_ARRAY:
{
JanetArray *array = janet_unwrap_array(ds);
if (index >= array->count) {
janet_array_ensure(array, index + 1, 2);
array->count = index + 1;
}
array->data[index] = value;
break;
}
case JANET_BUFFER:
{
JanetBuffer *buffer = janet_unwrap_buffer(ds);
vm_assert_type(value, JANET_INTEGER);
if (index >= buffer->count) {
janet_buffer_ensure(buffer, index + 1, 2);
buffer->count = index + 1;
}
buffer->data[index] = janet_unwrap_integer(value);
break;
}
} else if (status == -3) {
vm_throw("expected integer value for data structure");
}
}
++pc;
vm_checkgc_next();
@ -928,77 +730,16 @@ static void *op_lookup[255] = {
{
Janet ds = stack[oparg(2, 0xFF)];
Janet key = stack[oparg(3, 0xFF)];
Janet value;
switch (janet_type(ds)) {
default:
int status;
if ((status = janet_get(ds, key, stack + oparg(1, 0xFF)))) {
if (status == -1) {
expected_types = JANET_TFLAG_LENGTHABLE;
retreg = ds;
goto vm_type_error;
case JANET_STRUCT:
value = janet_struct_get(janet_unwrap_struct(ds), key);
break;
case JANET_TABLE:
value = janet_table_get(janet_unwrap_table(ds), key);
break;
case JANET_ARRAY:
{
JanetArray *array = janet_unwrap_array(ds);
int32_t index;
vm_assert_type(key, JANET_INTEGER);
index = janet_unwrap_integer(key);
if (index < 0 || index >= array->count) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = array->data[index];
}
break;
}
case JANET_TUPLE:
{
const Janet *tuple = janet_unwrap_tuple(ds);
int32_t index;
vm_assert_type(key, JANET_INTEGER);
index = janet_unwrap_integer(key);
if (index < 0 || index >= janet_tuple_length(tuple)) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = tuple[index];
}
break;
}
case JANET_BUFFER:
{
JanetBuffer *buffer = janet_unwrap_buffer(ds);
int32_t index;
vm_assert_type(key, JANET_INTEGER);
index = janet_unwrap_integer(key);
if (index < 0 || index >= buffer->count) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(buffer->data[index]);
}
break;
}
case JANET_STRING:
case JANET_SYMBOL:
{
const uint8_t *str = janet_unwrap_string(ds);
int32_t index;
vm_assert_type(key, JANET_INTEGER);
index = janet_unwrap_integer(key);
if (index < 0 || index >= janet_string_length(str)) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(str[index]);
}
break;
}
} else {
vm_throw("expected integer key for data structure");
}
}
stack[oparg(1, 0xFF)] = value;
++pc;
vm_next();
}
@ -1007,53 +748,11 @@ static void *op_lookup[255] = {
{
Janet ds = stack[oparg(2, 0xFF)];
int32_t index = oparg(3, 0xFF);
Janet value;
switch (janet_type(ds)) {
default:
expected_types = JANET_TFLAG_LENGTHABLE;
retreg = ds;
goto vm_type_error;
case JANET_STRING:
case JANET_SYMBOL:
if (index >= janet_string_length(janet_unwrap_string(ds))) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(janet_unwrap_string(ds)[index]);
}
break;
case JANET_ARRAY:
if (index >= janet_unwrap_array(ds)->count) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = janet_unwrap_array(ds)->data[index];
}
break;
case JANET_BUFFER:
if (index >= janet_unwrap_buffer(ds)->count) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = janet_wrap_integer(janet_unwrap_buffer(ds)->data[index]);
}
break;
case JANET_TUPLE:
if (index >= janet_tuple_length(janet_unwrap_tuple(ds))) {
/*vm_throw("index out of bounds");*/
value = janet_wrap_nil();
} else {
value = janet_unwrap_tuple(ds)[index];
}
break;
case JANET_TABLE:
value = janet_table_get(janet_unwrap_table(ds), janet_wrap_integer(index));
break;
case JANET_STRUCT:
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
break;
if (janet_getindex(ds, index, stack + oparg(1, 0xFF))) {
expected_types = JANET_TFLAG_LENGTHABLE;
retreg = ds;
goto vm_type_error;
}
stack[oparg(1, 0xFF)] = value;
++pc;
vm_next();
}
@ -1062,30 +761,10 @@ static void *op_lookup[255] = {
{
Janet x = stack[oparg(2, 0xFFFF)];
int32_t len;
switch (janet_type(x)) {
default:
expected_types = JANET_TFLAG_LENGTHABLE;
retreg = x;
goto vm_type_error;
case JANET_STRING:
case JANET_SYMBOL:
len = janet_string_length(janet_unwrap_string(x));
break;
case JANET_ARRAY:
len = janet_unwrap_array(x)->count;
break;
case JANET_BUFFER:
len = janet_unwrap_buffer(x)->count;
break;
case JANET_TUPLE:
len = janet_tuple_length(janet_unwrap_tuple(x));
break;
case JANET_STRUCT:
len = janet_struct_length(janet_unwrap_struct(x));
break;
case JANET_TABLE:
len = janet_unwrap_table(x)->count;
break;
if (janet_length(x, &len)) {
expected_types = JANET_TFLAG_LENGTHABLE;
retreg = x;
goto vm_type_error;
}
stack[oparg(1, 0xFF)] = janet_wrap_integer(len);
++pc;

15
src/core/wrap.c
View File

@ -45,10 +45,10 @@ Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
Janet janet_nanbox_from_double(double d) {
Janet ret;
ret.real = d;
ret.number = d;
/* Normalize NaNs */
if (d != d)
ret.u64 = janet_nanbox_tag(JANET_REAL);
ret.u64 = janet_nanbox_tag(JANET_NUMBER);
return ret;
}
@ -80,9 +80,9 @@ void janet_nanbox_memempty(JanetKV *mem, int32_t count) {
#elif defined(JANET_NANBOX_32)
Janet janet_wrap_real(double x) {
Janet janet_wrap_number(double x) {
Janet ret;
ret.real = x;
ret.number = x;
ret.tagged.type += JANET_DOUBLE_OFFSET;
return ret;
}
@ -101,9 +101,9 @@ Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer) {
return ret;
}
double janet_unwrap_real(Janet x) {
double janet_unwrap_number(Janet x) {
x.tagged.type -= JANET_DOUBLE_OFFSET;
return x.real;
return x.number;
}
#else
@ -151,8 +151,7 @@ Janet janet_wrap_##NAME(TYPE x) {\
return y;\
}
JANET_WRAP_DEFINE(real, double, JANET_REAL, real)
JANET_WRAP_DEFINE(integer, int32_t, JANET_INTEGER, integer)
JANET_WRAP_DEFINE(number, double, JANET_NUMBER, number)
JANET_WRAP_DEFINE(string, const uint8_t *, JANET_STRING, cpointer)
JANET_WRAP_DEFINE(symbol, const uint8_t *, JANET_SYMBOL, cpointer)
JANET_WRAP_DEFINE(array, JanetArray *, JANET_ARRAY, pointer)

124
src/include/janet/janet.h
View File

@ -203,7 +203,7 @@ extern "C" {
#include <stdarg.h>
/* Names of all of the types */
extern const char *const janet_type_names[16];
extern const char *const janet_type_names[15];
extern const char *const janet_signal_names[14];
extern const char *const janet_status_names[16];
@ -278,8 +278,7 @@ typedef enum JanetType {
JANET_FALSE,
JANET_TRUE,
JANET_FIBER,
JANET_INTEGER,
JANET_REAL,
JANET_NUMBER,
JANET_STRING,
JANET_SYMBOL,
JANET_ARRAY,
@ -299,8 +298,7 @@ typedef enum JanetType {
#define JANET_TFLAG_FALSE (1 << JANET_FALSE)
#define JANET_TFLAG_TRUE (1 << JANET_TRUE)
#define JANET_TFLAG_FIBER (1 << JANET_FIBER)
#define JANET_TFLAG_INTEGER (1 << JANET_INTEGER)
#define JANET_TFLAG_REAL (1 << JANET_REAL)
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
#define JANET_TFLAG_STRING (1 << JANET_STRING)
#define JANET_TFLAG_SYMBOL (1 << JANET_SYMBOL)
#define JANET_TFLAG_ARRAY (1 << JANET_ARRAY)
@ -314,7 +312,6 @@ typedef enum JanetType {
/* Some abstractions */
#define JANET_TFLAG_BOOLEAN (JANET_TFLAG_TRUE | JANET_TFLAG_FALSE)
#define JANET_TFLAG_NUMBER (JANET_TFLAG_REAL | JANET_TFLAG_INTEGER)
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER)
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
@ -349,7 +346,7 @@ typedef enum JanetType {
union Janet {
uint64_t u64;
int64_t i64;
double real;
double number;
void *pointer;
};
#define janet_u64(x) ((x).u64)
@ -359,19 +356,19 @@ union Janet {
#define janet_nanbox_lowtag(type) ((uint64_t)(type) | 0x1FFF0)
#define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47)
#define janet_type(x) \
(isnan((x).real) \
(isnan((x).number) \
? (((x).u64 >> 47) & 0xF) \
: JANET_REAL)
: JANET_NUMBER)
#define janet_nanbox_checkauxtype(x, type) \
(((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
#define janet_nanbox_isreal(x) \
(!isnan((x).real) || janet_nanbox_checkauxtype((x), JANET_REAL))
#define janet_nanbox_isnumber(x) \
(!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
#define janet_checktype(x, t) \
(((t) == JANET_REAL) \
? janet_nanbox_isreal(x) \
(((t) == JANET_NUMBER) \
? janet_nanbox_isnumber(x) \
: janet_nanbox_checkauxtype((x), (t)))
JANET_API void *janet_nanbox_to_pointer(Janet x);
@ -403,15 +400,12 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#define janet_wrap_true() janet_nanbox_from_payload(JANET_TRUE, 1)
#define janet_wrap_false() janet_nanbox_from_payload(JANET_FALSE, 1)
#define janet_wrap_boolean(b) janet_nanbox_from_payload((b) ? JANET_TRUE : JANET_FALSE, 1)
#define janet_wrap_integer(i) janet_nanbox_from_payload(JANET_INTEGER, (uint32_t)(i))
#define janet_wrap_real(r) janet_nanbox_from_double(r)
#define janet_wrap_number(r) janet_nanbox_from_double(r)
/* Unwrap the simple types */
#define janet_unwrap_boolean(x) \
(janet_checktype(x, JANET_TRUE))
#define janet_unwrap_integer(x) \
((int32_t)((x).u64 & 0xFFFFFFFFlu))
#define janet_unwrap_real(x) ((x).real)
#define janet_unwrap_number(x) ((x).number)
/* Wrap the pointer types */
#define janet_wrap_struct(s) janet_nanbox_wrap_c((s), JANET_STRUCT)
@ -459,20 +453,20 @@ union Janet {
uint32_t type;
#endif
} tagged;
double real;
double number;
uint64_t u64;
};
#define JANET_DOUBLE_OFFSET 0xFFFF
#define janet_u64(x) ((x).u64)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_REAL)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
#define janet_checktype(x, t) ((x).tagged.type == (t))
#define janet_memempty(mem, count) memset((mem), 0, sizeof(JanetKV) * (count))
#define janet_memalloc_empty(count) calloc((count), sizeof(JanetKV))
#define janet_truthy(x) ((x).tagged.type != JANET_NIL && (x).tagged.type != JANET_FALSE)
JANET_API Janet janet_wrap_real(double x);
JANET_API Janet janet_wrap_number(double x);
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
@ -480,7 +474,6 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_TRUE, 0)
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_FALSE, 0)
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi((b) ? JANET_TRUE : JANET_FALSE, 0)
#define janet_wrap_integer(i) janet_nanbox32_from_tagi(JANET_INTEGER, (i))
/* Wrap the pointer types */
#define janet_wrap_struct(s) janet_nanbox32_from_tagp(JANET_STRUCT, (void *)(s))
@ -508,8 +501,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
#define janet_unwrap_boolean(x) ((x).tagged.type == JANET_TRUE)
#define janet_unwrap_integer(x) ((x).tagged.payload.integer)
JANET_API double janet_unwrap_real(Janet x);
JANET_API double janet_unwrap_number(Janet x);
#else
@ -517,7 +509,7 @@ JANET_API double janet_unwrap_real(Janet x);
struct Janet {
union {
uint64_t u64;
double real;
double number;
int32_t integer;
void *pointer;
const void *cpointer;
@ -546,12 +538,10 @@ struct Janet {
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).as.pointer)
#define janet_unwrap_boolean(x) ((x).type == JANET_TRUE)
#define janet_unwrap_integer(x) ((x).as.integer)
#define janet_unwrap_real(x) ((x).as.real)
#define janet_unwrap_number(x) ((x).as.number)
JANET_API Janet janet_wrap_nil(void);
JANET_API Janet janet_wrap_real(double x);
JANET_API Janet janet_wrap_integer(int32_t x);
JANET_API Janet janet_wrap_number(double x);
JANET_API Janet janet_wrap_true(void);
JANET_API Janet janet_wrap_false(void);
JANET_API Janet janet_wrap_boolean(int x);
@ -570,6 +560,13 @@ JANET_API Janet janet_wrap_abstract(void *x);
/* End of tagged union implementation */
#endif
JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkint64(Janet x);
#define janet_checkintrange(x) ((x) == (int32_t)(x) && (x) >= INT32_MIN && (x) <= INT32_MAX)
#define janet_checkint64range(x) ((x) == (int64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
/* Hold components of arguments passed to JanetCFunction. */
struct JanetArgs {
Janet *v;
@ -797,20 +794,12 @@ enum JanetOpCode {
JOP_TYPECHECK,
JOP_RETURN,
JOP_RETURN_NIL,
JOP_ADD_INTEGER,
JOP_ADD_IMMEDIATE,
JOP_ADD_REAL,
JOP_ADD,
JOP_SUBTRACT_INTEGER,
JOP_SUBTRACT_REAL,
JOP_SUBTRACT,
JOP_MULTIPLY_INTEGER,
JOP_MULTIPLY_IMMEDIATE,
JOP_MULTIPLY_REAL,
JOP_MULTIPLY,
JOP_DIVIDE_INTEGER,
JOP_DIVIDE_IMMEDIATE,
JOP_DIVIDE_REAL,
JOP_DIVIDE,
JOP_BAND,
JOP_BOR,
@ -828,19 +817,11 @@ enum JanetOpCode {
JOP_JUMP_IF,
JOP_JUMP_IF_NOT,
JOP_GREATER_THAN,
JOP_GREATER_THAN_INTEGER,
JOP_GREATER_THAN_IMMEDIATE,
JOP_GREATER_THAN_REAL,
JOP_GREATER_THAN_EQUAL_REAL,
JOP_LESS_THAN,
JOP_LESS_THAN_INTEGER,
JOP_LESS_THAN_IMMEDIATE,
JOP_LESS_THAN_REAL,
JOP_LESS_THAN_EQUAL_REAL,
JOP_EQUALS,
JOP_EQUALS_INTEGER,
JOP_EQUALS_IMMEDIATE,
JOP_EQUALS_REAL,
JOP_COMPARE,
JOP_LOAD_NIL,
JOP_LOAD_TRUE,
@ -934,9 +915,8 @@ JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len,
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
/* Number scanning */
JANET_API Janet janet_scan_number(const uint8_t *src, int32_t len);
JANET_API int32_t janet_scan_integer(const uint8_t *str, int32_t len, int *err);
JANET_API double janet_scan_real(const uint8_t *str, int32_t len, int *err);
JANET_API double janet_scan_number(const uint8_t *str, int32_t len, int *err);
/* Debugging */
JANET_API int janet_debug_break(JanetFuncDef *def, int32_t pc);
@ -1102,6 +1082,11 @@ JANET_API int32_t janet_hash(Janet x);
JANET_API int janet_compare(Janet x, Janet y);
JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x);
JANET_API int janet_get(Janet ds, Janet key, Janet *out);
JANET_API int janet_getindex(Janet ds, int32_t index, Janet *out);
JANET_API int janet_length(Janet x, int32_t *out);
JANET_API int janet_put(Janet ds, Janet key, Janet value);
JANET_API int janet_putindex(Janet ds, int32_t index, Janet value);
/* VM functions */
JANET_API int janet_init(void);
@ -1176,19 +1161,6 @@ JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstr
}\
} while (0)
#define JANET_ARG_NUMBER(DEST, A, N) do { \
if ((A).n <= (N)) return janet_typemany_err(A, N, JANET_TFLAG_NUMBER); \
Janet _val_ = (A).v[(N)];\
JanetType _type_ = janet_type(_val_); \
if (_type_ == JANET_REAL) { \
DEST = janet_unwrap_real(_val_); \
} else if (_type_ == JANET_INTEGER) {\
DEST = (double) janet_unwrap_integer(_val_);\
} else { \
return janet_typemany_err(A, N, JANET_TFLAG_NUMBER); \
} \
} while (0)
#define JANET_ARG_BOOLEAN(DEST, A, N) do { \
JANET_CHECKMANY(A, N, JANET_TFLAG_TRUE | JANET_TFLAG_FALSE);\
DEST = janet_unwrap_boolean((A).v[(N)]); \
@ -1214,8 +1186,7 @@ JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstr
} while (0)
#define JANET_ARG_FIBER(DEST, A, N) _JANET_ARG(JANET_FIBER, fiber, DEST, A, N)
#define JANET_ARG_INTEGER(DEST, A, N) _JANET_ARG(JANET_INTEGER, integer, DEST, A, N)
#define JANET_ARG_REAL(DEST, A, N) _JANET_ARG(JANET_REAL, real, DEST, A, N)
#define JANET_ARG_NUMBER(DEST, A, N) _JANET_ARG(JANET_NUMBER, number, DEST, A, N)
#define JANET_ARG_STRING(DEST, A, N) _JANET_ARG(JANET_STRING, string, DEST, A, N)
#define JANET_ARG_SYMBOL(DEST, A, N) _JANET_ARG(JANET_SYMBOL, symbol, DEST, A, N)
#define JANET_ARG_ARRAY(DEST, A, N) _JANET_ARG(JANET_ARRAY, array, DEST, A, N)
@ -1226,6 +1197,30 @@ JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstr
#define JANET_ARG_FUNCTION(DEST, A, N) _JANET_ARG(JANET_FUNCTION, function, DEST, A, N)
#define JANET_ARG_CFUNCTION(DEST, A, N) _JANET_ARG(JANET_CFUNCTION, cfunction, DEST, A, N)
#define JANET_ARG_INTEGER(DEST, A, N) do { \
if ((A).n <= (N) || !janet_checktype((A).v[(N)], JANET_NUMBER)) { \
JANET_THROW(A, "expected integer"); \
} \
double _x_ = janet_unwrap_number((A).v[(N)]); \
if (janet_checkintrange(_x_)) { \
DEST = (int32_t) _x_; \
} else { \
JANET_THROW(A, "expected integer representable by 32 bits"); \
} \
} while (0)
#define JANET_ARG_INTEGER64(DEST, A, N) do { \
if ((A).n <= (N) || !janet_checktype((A).v[(N)], JANET_NUMBER)) { \
JANET_THROW(A, "expected integer"); \
} \
double _x_ = janet_unwrap_number((A).v[(N)]); \
if (janet_checkintrange64(_x_)) { \
DEST = (int64_t) _x_; \
} else { \
JANET_THROW(A, "expected integer representable by 64 bits"); \
} \
} while (0)
#define JANET_ARG_ABSTRACT(DEST, A, N, AT) do { \
JANET_CHECKABSTRACT(A, N, AT); \
DEST = janet_unwrap_abstract((A).v[(N)]); \
@ -1236,8 +1231,7 @@ JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstr
#define JANET_RETURN_TRUE(A) JANET_RETURN(A, janet_wrap_true())
#define JANET_RETURN_BOOLEAN(A, X) JANET_RETURN(A, janet_wrap_boolean(X))
#define JANET_RETURN_FIBER(A, X) JANET_RETURN(A, janet_wrap_fiber(X))
#define JANET_RETURN_INTEGER(A, X) JANET_RETURN(A, janet_wrap_integer(X))
#define JANET_RETURN_REAL(A, X) JANET_RETURN(A, janet_wrap_real(X))
#define JANET_RETURN_NUMBER(A, X) JANET_RETURN(A, janet_wrap_number(X))
#define JANET_RETURN_STRING(A, X) JANET_RETURN(A, janet_wrap_string(X))
#define JANET_RETURN_SYMBOL(A, X) JANET_RETURN(A, janet_wrap_symbol(X))
#define JANET_RETURN_ARRAY(A, X) JANET_RETURN(A, janet_wrap_array(X))
@ -1252,6 +1246,8 @@ JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstr
#define JANET_RETURN_CSTRING(A, X) JANET_RETURN(A, janet_cstringv(X))
#define JANET_RETURN_CSYMBOL(A, X) JANET_RETURN(A, janet_csymbolv(X))
#define JANET_RETURN_INTEGER(A, X) JANET_RETURN(A, janet_wrap_number((double) (X)))
/**** END SECTION MACROS *****/
#ifdef __cplusplus

2
test/suite0.janet
View File

@ -39,7 +39,7 @@
(assert (order< nil false true
(fiber/new (fn [] 1))
1 1.0 "hi"
1.0 "hi"
(quote hello)
(array 1 2 3)
(tuple 1 2 3)

5
test/suite1.janet
View File

@ -21,8 +21,7 @@
(import test/helper :prefix "" :exit true)
(start-suite 1)
(assert (= 400.0 (math/sqrt 160000)) "sqrt(160000)=400")
(assert (= (real 400) (math/sqrt 160000)) "sqrt(160000)=400")
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
(assert (= (get test-struct 'def) 1) "struct get")
@ -188,7 +187,7 @@
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
(def myfun (juxt + - * /))
(assert (= '[2 -2 2 0] (myfun 2)) "juxt")
(assert (= '[2 -2 2 0.5] (myfun 2)) "juxt")
# Case statements
(assert