1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-24 11:14:48 +00:00

Compare commits

...

5 Commits

Author SHA1 Message Date
Calvin Rose
1808c923bf Make negative indexing work like python.
This would break a lot of code :|
2023-07-14 17:18:20 -05:00
Calvin Rose
989f0726e3 Make encoding of immediate values capture full range. 2023-07-14 10:06:20 -05:00
Calvin Rose
4efcff33bd Update inttypes. 2023-07-13 19:58:38 -05:00
Calvin Rose
8183cc5a8d Disallow converting negative numbers to int/u64
The wrap-around rule doesn't make sense once subtraction is
properly fixed.
2023-07-09 22:25:20 -05:00
Calvin Rose
f3bda1536d Remove some dead code in cfuns.c 2023-07-09 22:02:10 -05:00
12 changed files with 44 additions and 59 deletions

View File

@@ -700,7 +700,7 @@
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x)))))) 4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
(let [[f g h i] functions] (let [[f g h i] functions]
(comp (fn [x] (f (g (h (i x))))) (comp (fn [x] (f (g (h (i x)))))
;(tuple/slice functions 4 -1))))) ;(tuple/slice functions 4)))))
(defn identity (defn identity
"A function that returns its argument." "A function that returns its argument."
@@ -1208,7 +1208,7 @@
(assert (symbol? alias) "alias must be a symbol") (assert (symbol? alias) "alias must be a symbol")
(assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters") (assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
(def prefix (dyn :defdyn-prefix)) (def prefix (dyn :defdyn-prefix))
(def kw (keyword prefix (slice alias 1 -2))) (def kw (keyword prefix (slice alias 1 -1)))
~(def ,alias :dyn ,;more ,kw)) ~(def ,alias :dyn ,;more ,kw))
(defn has-key? (defn has-key?
@@ -1821,7 +1821,7 @@
# Partition body into sections. # Partition body into sections.
(def oddlen (odd? (length cases))) (def oddlen (odd? (length cases)))
(def else (if oddlen (last cases))) (def else (if oddlen (last cases)))
(def patterns (partition 2 (if oddlen (slice cases 0 -2) cases))) (def patterns (partition 2 (if oddlen (slice cases 0 -1) cases)))
# Keep an array for accumulating the compilation output # Keep an array for accumulating the compilation output
(def x-sym (if (idempotent? x) x (gensym))) (def x-sym (if (idempotent? x) x (gensym)))
@@ -2052,7 +2052,7 @@
(tuple/slice (tuple/slice
(array/concat (array/concat
@[(in t 0) (expand-bindings bound)] @[(in t 0) (expand-bindings bound)]
(tuple/slice t 2 -2) (tuple/slice t 2 -1)
@[(recur last)]))) @[(recur last)])))
(defn expandall [t] (defn expandall [t]
@@ -2227,7 +2227,7 @@
[name & body] [name & body]
(def expansion (apply defn name body)) (def expansion (apply defn name body))
(def fbody (last expansion)) (def fbody (last expansion))
(def modifiers (tuple/slice expansion 2 -2)) (def modifiers (tuple/slice expansion 2 -1))
(def metadata @{}) (def metadata @{})
(each m modifiers (each m modifiers
(cond (cond
@@ -2917,7 +2917,7 @@
(def buf @"") (def buf @"")
(with-dyns [*err* buf *err-color* false] (with-dyns [*err* buf *err-color* false]
(bad-parse x y)) (bad-parse x y))
(set exit-error (string/slice buf 0 -2))) (set exit-error (string/slice buf 0 -1)))
(defn bc [&opt x y z a b] (defn bc [&opt x y z a b]
(when exit (when exit
(bad-compile x y z a b) (bad-compile x y z a b)
@@ -2926,7 +2926,7 @@
(def buf @"") (def buf @"")
(with-dyns [*err* buf *err-color* false] (with-dyns [*err* buf *err-color* false]
(bad-compile x nil z a b)) (bad-compile x nil z a b))
(set exit-error (string/slice buf 0 -2)) (set exit-error (string/slice buf 0 -1))
(set exit-fiber y)) (set exit-fiber y))
(unless f (unless f
(error (string "could not find file " path))) (error (string "could not find file " path)))
@@ -3789,7 +3789,7 @@
"Generate bindings for native functions in a convenient manner." "Generate bindings for native functions in a convenient manner."
[name ret-type & body] [name ret-type & body]
(def real-ret-type (eval ret-type)) (def real-ret-type (eval ret-type))
(def meta (slice body 0 -2)) (def meta (slice body 0 -1))
(def arg-pairs (partition 2 (last body))) (def arg-pairs (partition 2 (last body)))
(def formal-args (map 0 arg-pairs)) (def formal-args (map 0 arg-pairs))
(def type-args (map 1 arg-pairs)) (def type-args (map 1 arg-pairs))

View File

@@ -297,7 +297,7 @@ JANET_CORE_FN(cfun_array_remove,
int32_t at = janet_getinteger(argv, 1); int32_t at = janet_getinteger(argv, 1);
int32_t n = 1; int32_t n = 1;
if (at < 0) { if (at < 0) {
at = array->count + at + 1; at = array->count + at;
} }
if (at < 0 || at > array->count) if (at < 0 || at > array->count)
janet_panicf("removal index %d out of range [0,%d]", at, array->count); janet_panicf("removal index %d out of range [0,%d]", at, array->count);

View File

@@ -334,20 +334,11 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
} }
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) { int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length + 1;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
return not_raw;
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n); int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw; int32_t not_raw = raw;
if (not_raw < 0) not_raw += length; if (not_raw < 0) not_raw += length;
if (not_raw < 0 || not_raw > length) if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length); janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length, length);
return not_raw; return not_raw;
} }

View File

@@ -99,7 +99,7 @@ static JanetSlot opfunction(
static int can_be_imm(Janet x, int8_t *out) { static int can_be_imm(Janet x, int8_t *out) {
if (!janet_checkint(x)) return 0; if (!janet_checkint(x)) return 0;
int32_t integer = janet_unwrap_integer(x); int32_t integer = janet_unwrap_integer(x);
if (integer > 127 || integer < -127) return 0; if (integer > INT8_MAX || integer < INT8_MIN) return 0;
*out = (int8_t) integer; *out = (int8_t) integer;
return 1; return 1;
} }
@@ -121,8 +121,6 @@ static JanetSlot opreduce(
JanetCompiler *c = opts.compiler; JanetCompiler *c = opts.compiler;
int32_t i, len; int32_t i, len;
int8_t imm = 0; int8_t imm = 0;
int neg = opim < 0;
if (opim < 0) opim = -opim;
len = janet_v_count(args); len = janet_v_count(args);
JanetSlot t; JanetSlot t;
if (len == 0) { if (len == 0) {
@@ -139,13 +137,13 @@ static JanetSlot opreduce(
} }
t = janetc_gettarget(opts); t = janetc_gettarget(opts);
if (opim && can_slot_be_imm(args[1], &imm)) { if (opim && can_slot_be_imm(args[1], &imm)) {
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1); janetc_emit_ssi(c, opim, t, args[0], imm, 1);
} else { } else {
janetc_emit_sss(c, op, t, args[0], args[1], 1); janetc_emit_sss(c, op, t, args[0], args[1], 1);
} }
for (i = 2; i < len; i++) { for (i = 2; i < len; i++) {
if (opim && can_slot_be_imm(args[i], &imm)) { if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1); janetc_emit_ssi(c, opim, t, t, imm, 1);
} else { } else {
janetc_emit_sss(c, op, t, t, args[i], 1); janetc_emit_sss(c, op, t, t, args[i], 1);
} }

View File

@@ -118,10 +118,9 @@ int64_t janet_unwrap_s64(Janet x) {
default: default:
break; break;
case JANET_NUMBER : { case JANET_NUMBER : {
double dbl = janet_unwrap_number(x); double d = janet_unwrap_number(x);
if (fabs(dbl) <= MAX_INT_IN_DBL) if (!janet_checkint64range(d)) break;
return (int64_t)dbl; return (int64_t) d;
break;
} }
case JANET_STRING: { case JANET_STRING: {
int64_t value; int64_t value;
@@ -147,12 +146,9 @@ uint64_t janet_unwrap_u64(Janet x) {
default: default:
break; break;
case JANET_NUMBER : { case JANET_NUMBER : {
double dbl = janet_unwrap_number(x); double d = janet_unwrap_number(x);
/* Allow negative values to be cast to "wrap around". if (!janet_checkuint64range(d)) break;
* This let's addition and subtraction work as expected. */ return (uint64_t) d;
if (fabs(dbl) <= MAX_INT_IN_DBL)
return (uint64_t)dbl;
break;
} }
case JANET_STRING: { case JANET_STRING: {
uint64_t value; uint64_t value;
@@ -307,8 +303,8 @@ static int compare_double_double(double x, double y) {
static int compare_int64_double(int64_t x, double y) { static int compare_int64_double(int64_t x, double y) {
if (isnan(y)) { if (isnan(y)) {
return 0; // clojure and python do this return 0;
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) { } else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
double dx = (double) x; double dx = (double) x;
return compare_double_double(dx, y); return compare_double_double(dx, y);
} else if (y > ((double) INT64_MAX)) { } else if (y > ((double) INT64_MAX)) {
@@ -323,10 +319,10 @@ static int compare_int64_double(int64_t x, double y) {
static int compare_uint64_double(uint64_t x, double y) { static int compare_uint64_double(uint64_t x, double y) {
if (isnan(y)) { if (isnan(y)) {
return 0; // clojure and python do this return 0;
} else if (y < 0) { } else if (y < 0) {
return 1; return 1;
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) { } else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
double dx = (double) x; double dx = (double) x;
return compare_double_double(dx, y); return compare_double_double(dx, y);
} else if (y > ((double) UINT64_MAX)) { } else if (y > ((double) UINT64_MAX)) {
@@ -339,8 +335,9 @@ static int compare_uint64_double(uint64_t x, double y) {
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) { static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_S64) if (janet_is_int(argv[0]) != JANET_INT_S64) {
janet_panic("compare method requires int/s64 as first argument"); janet_panic("compare method requires int/s64 as first argument");
}
int64_t x = janet_unwrap_s64(argv[0]); int64_t x = janet_unwrap_s64(argv[0]);
switch (janet_type(argv[1])) { switch (janet_type(argv[1])) {
default: default:
@@ -355,7 +352,6 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
int64_t y = *(int64_t *)abst; int64_t y = *(int64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0)); return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_u64_type) { } else if (janet_abstract_type(abst) == &janet_u64_type) {
// comparing signed to unsigned -- be careful!
uint64_t y = *(uint64_t *)abst; uint64_t y = *(uint64_t *)abst;
if (x < 0) { if (x < 0) {
return janet_wrap_number(-1); return janet_wrap_number(-1);
@@ -374,8 +370,9 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) { static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed? if (janet_is_int(argv[0]) != JANET_INT_U64) {
janet_panic("compare method requires int/u64 as first argument"); janet_panic("compare method requires int/u64 as first argument");
}
uint64_t x = janet_unwrap_u64(argv[0]); uint64_t x = janet_unwrap_u64(argv[0]);
switch (janet_type(argv[1])) { switch (janet_type(argv[1])) {
default: default:
@@ -390,7 +387,6 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
uint64_t y = *(uint64_t *)abst; uint64_t y = *(uint64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0)); return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_s64_type) { } else if (janet_abstract_type(abst) == &janet_s64_type) {
// comparing unsigned to signed -- be careful!
int64_t y = *(int64_t *)abst; int64_t y = *(int64_t *)abst;
if (y < 0) { if (y < 0) {
return janet_wrap_number(1); return janet_wrap_number(1);

View File

@@ -1997,7 +1997,6 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at); JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv); JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which); JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags); JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
/* Optionals */ /* Optionals */

View File

@@ -44,7 +44,7 @@
(number? x) (string x) (number? x) (string x)
(string? x) (string/slice x (string? x) (string/slice x
(length "test/suite-") (length "test/suite-")
(- (inc (length ".janet")))) (- (length ".janet")))
(string x))) (string x)))
(set start-time (os/clock)) (set start-time (os/clock))
(eprint "Starting suite " suite-name "...")) (eprint "Starting suite " suite-name "..."))

View File

@@ -37,14 +37,14 @@
(assert (array= @[:one :two :three :four :five] (assert (array= @[:one :two :three :four :five]
@[:one :two :three :four :five]) "array comparison 3") @[:one :two :three :four :five]) "array comparison 3")
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1") (assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2") (assert (array= (array/slice @[0 7 3 9 1 4] 2 -1) @[3 9 1]) "array/slice 2")
# Array remove # Array remove
# 687a3c9 # 687a3c9
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1") (assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2") (assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3") (assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
(assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4") (assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
# array/peek # array/peek

View File

@@ -96,13 +96,13 @@
# Regression #301 # Regression #301
# a3d4ecddb # a3d4ecddb
(def b (buffer/new-filled 128 0x78)) (def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1") (assert (= 38 (length (buffer/blit @"" b 0 90))) "buffer/blit 1")
(def a @"abcdefghijklm") (def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2") (assert (deep= @"abcde" (buffer/blit @"" a 0 0 5)) "buffer/blit 2")
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3") (assert (deep= @"bcde" (buffer/blit @"" a 0 1 5)) "buffer/blit 3")
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4") (assert (deep= @"cde" (buffer/blit @"" a 0 2 5)) "buffer/blit 4")
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5") (assert (deep= @"de" (buffer/blit @"" a 0 3 5)) "buffer/blit 5")
# buffer/push-at # buffer/push-at
# c55d93512 # c55d93512

View File

@@ -196,7 +196,8 @@
(assert-error "division by zero" (op (int 7) (int 0))))) (assert-error "division by zero" (op (int 7) (int 0)))))
(each int [int/s64 int/u64] (each int [int/s64 int/u64]
(loop [x :in [-5 -3 0 3 5]] (loop [x :in [-5 -3 0 3 5] :when (or (pos? x) (= int int/s64))]
# skip check when comparing negative values with unsigned integers.
(assert (= (int x) (mod (int x) 0)) (string int " mod 0")) (assert (= (int x) (mod (int x) 0)) (string int " mod 0"))
(assert (= (int x) (mod x (int 0))) (string int " mod 0")) (assert (= (int x) (mod x (int 0))) (string int " mod 0"))
(assert (= (int x) (mod (int x) (int 0))) (string int " mod 0")))) (assert (= (int x) (mod (int x) (int 0))) (string int " mod 0"))))
@@ -267,12 +268,12 @@
# compare u64/i64 # compare u64/i64
(assert (= (compare (u64 1) (i64 2)) -1) "compare 7") (assert (= (compare (u64 1) (i64 2)) -1) "compare 7")
(assert (= (compare (u64 1) (i64 -1)) +1) "compare 8") (assert (= (compare (u64 1) (i64 -1)) +1) "compare 8")
(assert (= (compare (u64 -1) (i64 -1)) +1) "compare 9") (assert (= (compare (u64 0) (i64 -1)) +1) "compare 9")
# compare i64/u64 # compare i64/u64
(assert (= (compare (i64 1) (u64 2)) -1) "compare 10") (assert (= (compare (i64 1) (u64 2)) -1) "compare 10")
(assert (= (compare (i64 -1) (u64 1)) -1) "compare 11") (assert (= (compare (i64 -1) (u64 1)) -1) "compare 11")
(assert (= (compare (i64 -1) (u64 -1)) -1) "compare 12") (assert (= (compare (i64 -1) (u64 0)) -1) "compare 12")
# off by 1 error in inttypes # off by 1 error in inttypes
# a3e812b86 # a3e812b86

View File

@@ -69,7 +69,7 @@
(def first-nl (= (chr "\n") (first str))) (def first-nl (= (chr "\n") (first str)))
(def last-nl (= (chr "\n") (last str))) (def last-nl (= (chr "\n") (last str)))
(string/slice str (if first-nl 1 0) (if last-nl -2))) (string/slice str (if first-nl 1 0) (if last-nl -1)))
(defn reindent-reference (defn reindent-reference
"Same as reindent but use parser functionality. Useful for "Same as reindent but use parser functionality. Useful for

View File

@@ -32,10 +32,10 @@
# Buffer self blitting, check for use after free # Buffer self blitting, check for use after free
# bbcfaf128 # bbcfaf128
(def buf1 @"1234567890") (def buf1 @"1234567890")
(buffer/blit buf1 buf1 -1) (buffer/blit buf1 buf1 (length buf1))
(buffer/blit buf1 buf1 -1) (buffer/blit buf1 buf1 (length buf1))
(buffer/blit buf1 buf1 -1) (buffer/blit buf1 buf1 (length buf1))
(buffer/blit buf1 buf1 -1) (buffer/blit buf1 buf1 (length buf1))
(assert (= (string buf1) (string/repeat "1234567890" 16)) (assert (= (string buf1) (string/repeat "1234567890" 16))
"buffer blit against self") "buffer blit against self")