From 2c72d259af2b6e68fd78055a804d0386c70e542d Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 30 May 2022 17:21:47 -0500 Subject: [PATCH] Add json and typedarrays to spork. --- project.janet | 15 ++ spork/init.janet | 2 + src/json.c | 597 +++++++++++++++++++++++++++++++++++++++++ src/tarray.c | 614 +++++++++++++++++++++++++++++++++++++++++++ src/tarray.h | 85 ++++++ test/suite0014.janet | 30 +++ test/suite0015.janet | 83 ++++++ 7 files changed, 1426 insertions(+) create mode 100644 src/json.c create mode 100644 src/tarray.c create mode 100644 src/tarray.h create mode 100644 test/suite0014.janet create mode 100644 test/suite0015.janet diff --git a/project.janet b/project.janet index 267b74a..0dd5fda 100644 --- a/project.janet +++ b/project.janet @@ -7,3 +7,18 @@ (declare-source :source @["spork"]) + +# Natives + +(declare-native + :name "spork/json" + :source @["src/json.c"]) + +(declare-native + :name "spork/tarray" + :headers @["src/tarray.h"] + :source @["src/tarray.c"]) + +(declare-headers + :headers ["src/tarray.h"]) + diff --git a/spork/init.janet b/spork/init.janet index ffad5cf..4e32b3e 100644 --- a/spork/init.janet +++ b/spork/init.janet @@ -13,3 +13,5 @@ (import ./schema :export true) (import ./temple :export true) (import ./test :export true) +(import spork/json :export true) +(import spork/tarray :export true) diff --git a/src/json.c b/src/json.c new file mode 100644 index 0000000..3b74ef4 --- /dev/null +++ b/src/json.c @@ -0,0 +1,597 @@ +/* +* Copyright (c) 2018 Calvin Rose +* +* 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. +*/ + +#include +#include +#include + +/*****************/ +/* JSON Decoding */ +/*****************/ + +#define JSON_KEYWORD_KEY 0x10000 +#define JSON_NULL_TO_NIL 0x20000 + +/* Check if a character is whitespace */ +static int white(uint8_t c) { + return c == '\t' || c == '\n' || c == ' ' || c == '\r'; +} + +/* Skip whitespace */ +static void skipwhite(const char **p) { + const char *cp = *p; + for (;;) { + if (white(*cp)) + cp++; + else + break; + } + *p = cp; +} + +/* Get a hex digit value */ +static int hexdig(char dig) { + if (dig >= '0' && dig <= '9') + return dig - '0'; + if (dig >= 'a' && dig <= 'f') + return 10 + dig - 'a'; + if (dig >= 'A' && dig <= 'F') + return 10 + dig - 'A'; + return -1; +} + +/* Convert integer to hex character */ +static const char hex_digits[] = "0123456789ABCDEF"; +#define tohex(x) (hex_digits[x]) + +/* Read the hex value for a unicode escape */ +static const char *decode_utf16_escape(const char *p, uint32_t *outpoint) { + if (!p[0] || !p[1] || !p[2] || !p[3]) + return "unexpected end of source"; + int d1 = hexdig(p[0]); + int d2 = hexdig(p[1]); + int d3 = hexdig(p[2]); + int d4 = hexdig(p[3]); + if (d1 < 0 || d2 < 0 || d3 < 0 || d4 < 0) + return "invalid hex digit"; + *outpoint = d4 | (d3 << 4) | (d2 << 8) | (d1 << 12); + return NULL; +} + +/* Parse a string. Also handles the conversion of utf-16 to + * utf-8. */ +static const char *decode_string(const char **p, Janet *out) { + JanetBuffer *buffer = janet_buffer(0); + const char *cp = *p; + while (*cp != '"') { + uint8_t b = (uint8_t) *cp; + if (b < 32) return "invalid character in string"; + if (b == '\\') { + cp++; + switch(*cp) { + default: + return "unknown string escape"; + case 'b': + b = '\b'; + break; + case 'f': + b = '\f'; + break; + case 'n': + b = '\n'; + break; + case 'r': + b = '\r'; + break; + case 't': + b = '\t'; + break; + case '"': + b = '"'; + break; + case '\\': + b = '\\'; + break; + case '/': + b = '/'; + break; + case 'u': + { + /* Get codepoint and check for surrogate pair */ + uint32_t codepoint; + const char *err = decode_utf16_escape(cp + 1, &codepoint); + if (err) return err; + if (codepoint >= 0xDC00 && codepoint <= 0xDFFF) { + return "unexpected utf-16 low surrogate"; + } else if (codepoint >= 0xD800 && codepoint <= 0xDBFF) { + if (cp[5] != '\\') return "expected utf-16 low surrogate pair"; + if (cp[6] != 'u') return "expected utf-16 low surrogate pair"; + uint32_t lowsur; + const char *err = decode_utf16_escape(cp + 7, &lowsur); + if (err) return err; + if (lowsur < 0xDC00 || lowsur > 0xDFFF) + return "expected utf-16 low surrogate pair"; + codepoint = ((codepoint - 0xD800) << 10) + + (lowsur - 0xDC00) + 0x10000; + cp += 11; + } else { + cp += 5; + } + /* Write codepoint */ + if (codepoint <= 0x7F) { + janet_buffer_push_u8(buffer, codepoint); + } else if (codepoint <= 0x7FF) { + janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x1F) | 0xC0); + janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80); + } else if (codepoint <= 0xFFFF) { + janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x0F) | 0xE0); + janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80); + janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80); + } else { + janet_buffer_push_u8(buffer, ((codepoint >> 18) & 0x07) | 0xF0); + janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x3F) | 0x80); + janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80); + janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80); + } + } + continue; + } + } + janet_buffer_push_u8(buffer, b); + cp++; + } + *out = janet_stringv(buffer->data, buffer->count); + *p = cp + 1; + return NULL; +} + +static const char *decode_one(const char **p, Janet *out, int depth) { + + /* Prevent stack overflow */ + if ((depth & 0xFFFF) > JANET_RECURSION_GUARD) goto recurdepth; + + /* Skip leading whitepspace */ + skipwhite(p); + + /* Main switch */ + switch (**p) { + default: + goto badchar; + case '\0': + goto eos; + /* Numbers */ + case '-': case '0': case '1' : case '2': case '3' : case '4': + case '5': case '6': case '7' : case '8': case '9': + { + errno = 0; + char *end = NULL; + double x = strtod(*p, &end); + if (end == *p) goto badnum; + *p = end; + *out = janet_wrap_number(x); + break; + } + /* false, null, true */ + case 'f': + { + const char *cp = *p; + if (cp[1] != 'a' || cp[2] != 'l' || cp[3] != 's' || cp[4] != 'e') + goto badident; + *out = janet_wrap_false(); + *p = cp + 5; + break; + } + case 'n': + { + const char *cp = *p; + + if (cp[1] != 'u' || cp[2] != 'l' || cp[3] != 'l') + goto badident; + if (depth & JSON_NULL_TO_NIL) { + *out = janet_wrap_nil(); + } else { + *out = janet_ckeywordv("null"); + } + *p = cp + 4; + break; + } + case 't': + { + const char *cp = *p; + if (cp[1] != 'r' || cp[2] != 'u' || cp[3] != 'e') + goto badident; + *out = janet_wrap_true(); + *p = cp + 4; + break; + } + /* String */ + case '"': + { + const char *cp = *p + 1; + const char *start = cp; + while ((*cp >= 32 || *cp < 0) && *cp != '"' && *cp != '\\') + cp++; + /* Only use a buffer for strings with escapes, else just copy + * memory from source */ + if (*cp == '\\') { + *p = *p + 1; + const char *err = decode_string(p, out); + if (err) return err; + break; + } + if (*cp != '"') goto badchar; + *p = cp + 1; + *out = janet_stringv((const uint8_t *)start, cp - start); + break; + } + /* Array */ + case '[': + { + *p = *p + 1; + JanetArray *array = janet_array(0); + const char *err; + Janet subval; + skipwhite(p); + while (**p != ']') { + err = decode_one(p, &subval, depth + 1); + if (err) return err; + janet_array_push(array, subval); + skipwhite(p); + if (**p == ']') break; + if (**p != ',') goto wantcomma; + *p = *p + 1; + } + *p = *p + 1; + *out = janet_wrap_array(array); + } + break; + /* Object */ + case '{': + { + *p = *p + 1; + JanetTable *table = janet_table(0); + const char *err; + Janet subkey, subval; + skipwhite(p); + while (**p != '}') { + skipwhite(p); + if (**p != '"') goto wantstring; + err = decode_one(p, &subkey, depth + 1); + if (err) return err; + skipwhite(p); + if (**p != ':') goto wantcolon; + *p = *p + 1; + err = decode_one(p, &subval, depth + 1); + if (err) return err; + if (depth & JSON_KEYWORD_KEY) { + JanetString str = janet_unwrap_string(subkey); + subkey = janet_keywordv(str, janet_string_length(str)); + } + janet_table_put(table, subkey, subval); + skipwhite(p); + if (**p == '}') break; + if (**p != ',') goto wantcomma; + *p = *p + 1; + } + *p = *p + 1; + *out = janet_wrap_table(table); + break; + } + } + + /* Good return */ + return NULL; + + /* Errors */ +recurdepth: + return "recured too deeply"; +eos: + return "unexpected end of source"; +badident: + return "bad identifier"; +badnum: + return "bad number"; +wantcomma: + return "expected comma"; +wantcolon: + return "expected colon"; +badchar: + return "unexpected character"; +wantstring: + return "expected json string"; +} + +static Janet json_decode(int32_t argc, Janet *argv) { + janet_arity(argc, 1, 3); + Janet ret = janet_wrap_nil(); + const char *err; + const char *start; + const char *p; + if (janet_checktype(argv[0], JANET_BUFFER)) { + JanetBuffer *buffer = janet_unwrap_buffer(argv[0]); + /* Ensure 0 padded */ + janet_buffer_push_u8(buffer, 0); + buffer->count--; + start = p = (const char *)buffer->data; + } else { + JanetByteView bytes = janet_getbytes(argv, 0); + start = p = (const char *)bytes.bytes; + } + int flags = 0; + if (argc > 1 && janet_truthy(argv[1])) flags |= JSON_KEYWORD_KEY; + if (argc > 2 && janet_truthy(argv[2])) flags |= JSON_NULL_TO_NIL; + err = decode_one(&p, &ret, flags); + /* Check trailing values */ + if (!err) { + skipwhite(&p); + if (*p) err = "unexpected extra token"; + } + if (err) + janet_panicf("decode error at position %d: %s", p - start, err); + return ret; +} + +/*****************/ +/* JSON Encoding */ +/*****************/ + +typedef struct { + JanetBuffer *buffer; + int32_t indent; + const uint8_t *tab; + const uint8_t *newline; + int32_t tablen; + int32_t newlinelen; +} Encoder; + +static void encode_newline(Encoder *e) { + janet_buffer_push_bytes(e->buffer, e->newline, e->newlinelen); + /* Skip loop if no tab string */ + if (!e->tablen) return; + for (int32_t i = 0; i < e->indent; i++) + janet_buffer_push_bytes(e->buffer, e->tab, e->tablen); +} + +static const char *encode_one(Encoder *e, Janet x, int depth) { + switch(janet_type(x)) { + default: + goto badtype; + case JANET_NIL: + janet_buffer_push_cstring(e->buffer, "null"); + break; + case JANET_BOOLEAN: + janet_buffer_push_cstring(e->buffer, + janet_unwrap_boolean(x) ? "true" : "false"); + break; + case JANET_NUMBER: + { + char cbuf[25]; + sprintf(cbuf, "%.17g", janet_unwrap_number(x)); + janet_buffer_push_cstring(e->buffer, cbuf); + } + break; + case JANET_STRING: + case JANET_SYMBOL: + case JANET_KEYWORD: + case JANET_BUFFER: + { + const uint8_t *bytes; + const uint8_t *c; + const uint8_t *end; + int32_t len; + janet_bytes_view(x, &bytes, &len); + janet_buffer_push_u8(e->buffer, '"'); + c = bytes; + end = bytes + len; + while (c < end) { + + /* get codepoint */ + uint32_t codepoint; + if (*c < 0x80) { + /* one byte */ + codepoint = *c++; + } else if (*c < 0xE0) { + /* two bytes */ + if (c + 2 > end) goto invalidutf8; + if ((c[1] >> 6) != 2) goto invalidutf8; + codepoint = ((c[0] & 0x1F) << 6) | + (c[1] & 0x3F); + c += 2; + } else if (*c < 0xF0) { + /* three bytes */ + if (c + 3 > end) goto invalidutf8; + if ((c[1] >> 6) != 2) goto invalidutf8; + if ((c[2] >> 6) != 2) goto invalidutf8; + codepoint = ((c[0] & 0x0F) << 12) | + ((c[1] & 0x3F) << 6) | + (c[2] & 0x3F); + c += 3; + } else if (*c < 0xF8) { + /* four bytes */ + if (c + 4 > end) goto invalidutf8; + if ((c[1] >> 6) != 2) goto invalidutf8; + if ((c[2] >> 6) != 2) goto invalidutf8; + if ((c[3] >> 6) != 2) goto invalidutf8; + codepoint = ((c[0] & 0x07) << 18) | + ((c[1] & 0x3F) << 12) | + ((c[3] & 0x3F) << 6) | + (c[3] & 0x3F); + c += 4; + } else { + /* invalid */ + goto invalidutf8; + } + + /* write codepoint */ + if (codepoint > 0x1F && codepoint < 0x80) { + /* Normal, no escape */ + if (codepoint == '\\' || codepoint == '"') + janet_buffer_push_u8(e->buffer, '\\'); + janet_buffer_push_u8(e->buffer, (uint8_t) codepoint); + } else if (codepoint < 0x10000) { + /* One unicode escape */ + uint8_t buf[6]; + buf[0] = '\\'; + buf[1] = 'u'; + buf[2] = tohex((codepoint >> 12) & 0xF); + buf[3] = tohex((codepoint >> 8) & 0xF); + buf[4] = tohex((codepoint >> 4) & 0xF); + buf[5] = tohex(codepoint & 0xF); + janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)); + } else { + /* Two unicode escapes (surrogate pair) */ + uint32_t hi, lo; + uint8_t buf[12]; + hi = ((codepoint - 0x10000) >> 10) + 0xD800; + lo = ((codepoint - 0x10000) & 0x3FF) + 0xDC00; + buf[0] = '\\'; + buf[1] = 'u'; + buf[2] = tohex((hi >> 12) & 0xF); + buf[3] = tohex((hi >> 8) & 0xF); + buf[4] = tohex((hi >> 4) & 0xF); + buf[5] = tohex(hi & 0xF); + buf[6] = '\\'; + buf[7] = 'u'; + buf[8] = tohex((lo >> 12) & 0xF); + buf[9] = tohex((lo >> 8) & 0xF); + buf[10] = tohex((lo >> 4) & 0xF); + buf[11] = tohex(lo & 0xF); + janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)); + } + } + janet_buffer_push_u8(e->buffer, '"'); + } + break; + case JANET_TUPLE: + case JANET_ARRAY: + { + const char *err; + const Janet *items; + int32_t len; + janet_indexed_view(x, &items, &len); + janet_buffer_push_u8(e->buffer, '['); + e->indent++; + for (int32_t i = 0; i < len; i++) { + encode_newline(e); + if ((err = encode_one(e, items[i], depth + 1))) return err; + janet_buffer_push_u8(e->buffer, ','); + } + e->indent--; + if (e->buffer->data[e->buffer->count - 1] == ',') { + e->buffer->count--; + encode_newline(e); + } + janet_buffer_push_u8(e->buffer, ']'); + } + break; + case JANET_TABLE: + case JANET_STRUCT: + { + const char *err; + const JanetKV *kvs; + int32_t count, capacity; + janet_dictionary_view(x, &kvs, &count, &capacity); + janet_buffer_push_u8(e->buffer, '{'); + e->indent++; + for (int32_t i = 0; i < capacity; i++) { + if (janet_checktype(kvs[i].key, JANET_NIL)) + continue; + if (!janet_checktypes(kvs[i].key, JANET_TFLAG_BYTES)) + return "object key must be a byte sequence"; + encode_newline(e); + if ((err = encode_one(e, kvs[i].key, depth + 1))) + return err; + const char *sep = e->tablen ? ": " : ":"; + janet_buffer_push_cstring(e->buffer, sep); + if ((err = encode_one(e, kvs[i].value, depth + 1))) + return err; + janet_buffer_push_u8(e->buffer, ','); + } + e->indent--; + if (e->buffer->data[e->buffer->count - 1] == ',') { + e->buffer->count--; + encode_newline(e); + } + janet_buffer_push_u8(e->buffer, '}'); + } + break; + } + return NULL; + + /* Errors */ + +badtype: + return "type not supported"; +invalidutf8: + return "string contains invalid utf-8"; +} + +static Janet json_encode(int32_t argc, Janet *argv) { + janet_arity(argc, 1, 4); + Encoder e; + e.indent = 0; + e.buffer = janet_optbuffer(argv, argc, 3, 10); + e.tab = NULL; + e.newline = NULL; + e.tablen = 0; + e.newlinelen = 0; + if (argc >= 2) { + JanetByteView tab = janet_getbytes(argv, 1); + e.tab = tab.bytes; + e.tablen = tab.len; + if (argc >= 3) { + JanetByteView newline = janet_getbytes(argv, 2); + e.newline = newline.bytes; + e.newlinelen = newline.len; + } else { + e.newline = (const uint8_t *)"\r\n"; + e.newlinelen = 2; + } + } + const char *err = encode_one(&e, argv[0], 0); + if (err) janet_panicf("encode error: %s", err); + return janet_wrap_buffer(e.buffer); +} + +/****************/ +/* Module Entry */ +/****************/ + +static const JanetReg cfuns[] = { + {"encode", json_encode, + "(json/encode x &opt tab newline buf)\n\n" + "Encodes a janet value in JSON (utf-8). tab and newline are optional byte sequence which are used " + "to format the output JSON. if buf is provided, the formated JSON is append to buf instead of a new buffer. " + "Returns the modifed buffer." + }, + {"decode", json_decode, + "(json/decode json-source &opt keywords nils)\n\n" + "Returns a janet object after parsing JSON. If keywords is truthy, string " + "keys will be converted to keywords. If nils is truthy, null will become nil instead " + "of the keyword :null." + }, + {NULL, NULL, NULL} +}; + +JANET_MODULE_ENTRY(JanetTable *env) { + janet_cfuns(env, "json", cfuns); +} diff --git a/src/tarray.c b/src/tarray.c new file mode 100644 index 0000000..2b7bda2 --- /dev/null +++ b/src/tarray.c @@ -0,0 +1,614 @@ +/* +* Copyright (c) 2021 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. +*/ + +#include +#include "tarray.h" + +static char *ta_type_names[] = { + "uint8", + "int8", + "uint16", + "int16", + "uint32", + "int32", + "uint64", + "int64", + "float32", + "float64", + "?" +}; + +static size_t ta_type_sizes[] = { + sizeof(uint8_t), + sizeof(int8_t), + sizeof(uint16_t), + sizeof(int16_t), + sizeof(uint32_t), + sizeof(int32_t), + sizeof(uint64_t), + sizeof(int64_t), + sizeof(float), + sizeof(double), + 0 +}; + +#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1) +#define TA_ATOM_MAXSIZE 8 +#define TA_FLAG_BIG_ENDIAN 1 + +static JanetTArrayType get_ta_type_by_name(const uint8_t *name) { + for (int i = 0; i < TA_COUNT_TYPES; i++) { + if (!janet_cstrcmp(name, ta_type_names[i])) + return i; + } + janet_panicf("invalid typed array type %S", name); + return 0; +} + +static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) { + buf->data = NULL; + if (size > 0) { + buf->data = (uint8_t *)calloc(size, sizeof(uint8_t)); + if (buf->data == NULL) { + janet_panic("out of memory"); + } + } + buf->size = size; +#ifdef JANET_BIG_ENDIAN + buf->flags = TA_FLAG_BIG_ENDIAN; +#else + buf->flags = 0; +#endif + return buf; +} + +static int ta_buffer_gc(void *p, size_t s) { + (void) s; + JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p; + free(buf->data); + return 0; +} + +static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) { + JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p; + janet_marshal_abstract(ctx, p); + janet_marshal_size(ctx, buf->size); + janet_marshal_int(ctx, buf->flags); + janet_marshal_bytes(ctx, buf->data, buf->size); +} + +static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) { + JanetTArrayBuffer *buf = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayBuffer)); + size_t size = janet_unmarshal_size(ctx); + int32_t flags = janet_unmarshal_int(ctx); + ta_buffer_init(buf, size); + buf->flags = flags; + janet_unmarshal_bytes(ctx, buf->data, size); + return buf; +} + +const JanetAbstractType janet_ta_buffer_type = { + "ta/buffer", + ta_buffer_gc, + NULL, + NULL, + NULL, + ta_buffer_marshal, + ta_buffer_unmarshal, + JANET_ATEND_UNMARSHAL +}; + +static int ta_mark(void *p, size_t s) { + (void) s; + JanetTArrayView *view = (JanetTArrayView *)p; + janet_mark(janet_wrap_abstract(view->buffer)); + return 0; +} + +static void ta_view_marshal(void *p, JanetMarshalContext *ctx) { + JanetTArrayView *view = (JanetTArrayView *)p; + size_t offset = (view->buffer->data - view->as.u8); + janet_marshal_abstract(ctx, p); + janet_marshal_size(ctx, view->size); + janet_marshal_size(ctx, view->stride); + janet_marshal_int(ctx, view->type); + janet_marshal_size(ctx, offset); + janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer)); +} + +static void *ta_view_unmarshal(JanetMarshalContext *ctx) { + size_t offset; + int32_t atype; + Janet buffer; + JanetTArrayView *view = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayView)); + view->size = janet_unmarshal_size(ctx); + view->stride = janet_unmarshal_size(ctx); + atype = janet_unmarshal_int(ctx); + if (atype < 0 || atype >= TA_COUNT_TYPES) + janet_panic("bad typed array type"); + view->type = atype; + offset = janet_unmarshal_size(ctx); + buffer = janet_unmarshal_janet(ctx); + if (!janet_checktype(buffer, JANET_ABSTRACT) || + (janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) { + janet_panicf("expected typed array buffer"); + } + view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer); + size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1); + if (view->buffer->size < buf_need_size) + janet_panic("bad typed array offset in marshalled data"); + view->as.u8 = view->buffer->data + offset; + return view; +} + +static JanetMethod tarray_view_methods[6]; + +static int ta_getter(void *p, Janet key, Janet *out) { + size_t index, i; + JanetTArrayView *array = p; + if (janet_checktype(key, JANET_KEYWORD)) { + return janet_getmethod(janet_unwrap_keyword(key), tarray_view_methods, out); + } + if (!janet_checksize(key)) janet_panic("expected size as key"); + index = (size_t) janet_unwrap_number(key); + i = index * array->stride; + if (index >= array->size) { + return 0; + } else { + switch (array->type) { + case JANET_TARRAY_TYPE_U8: + *out = janet_wrap_number(array->as.u8[i]); + break; + case JANET_TARRAY_TYPE_S8: + *out = janet_wrap_number(array->as.s8[i]); + break; + case JANET_TARRAY_TYPE_U16: + *out = janet_wrap_number(array->as.u16[i]); + break; + case JANET_TARRAY_TYPE_S16: + *out = janet_wrap_number(array->as.s16[i]); + break; + case JANET_TARRAY_TYPE_U32: + *out = janet_wrap_number(array->as.u32[i]); + break; + case JANET_TARRAY_TYPE_S32: + *out = janet_wrap_number(array->as.s32[i]); + break; +#ifdef JANET_INT_TYPES + case JANET_TARRAY_TYPE_U64: + *out = janet_wrap_u64(array->as.u64[i]); + break; + case JANET_TARRAY_TYPE_S64: + *out = janet_wrap_s64(array->as.s64[i]); + break; +#endif + case JANET_TARRAY_TYPE_F32: + *out = janet_wrap_number_safe(array->as.f32[i]); + break; + case JANET_TARRAY_TYPE_F64: + *out = janet_wrap_number_safe(array->as.f64[i]); + break; + default: + janet_panicf("cannot get from typed array of type %s", + ta_type_names[array->type]); + break; + } + } + return 1; +} + +static void ta_setter(void *p, Janet key, Janet value) { + size_t index, i; + if (!janet_checksize(key)) janet_panic("expected size as key"); + index = (size_t) janet_unwrap_number(key); + JanetTArrayView *array = p; + i = index * array->stride; + if (index >= array->size) { + janet_panic("index out of bounds"); + } + if (!janet_checktype(value, JANET_NUMBER) && + array->type != JANET_TARRAY_TYPE_U64 && + array->type != JANET_TARRAY_TYPE_S64) { + janet_panic("expected number value"); + } + switch (array->type) { + case JANET_TARRAY_TYPE_U8: + array->as.u8[i] = (uint8_t) janet_unwrap_number(value); + break; + case JANET_TARRAY_TYPE_S8: + array->as.s8[i] = (int8_t) janet_unwrap_number(value); + break; + case JANET_TARRAY_TYPE_U16: + array->as.u16[i] = (uint16_t) janet_unwrap_number(value); + break; + case JANET_TARRAY_TYPE_S16: + array->as.s16[i] = (int16_t) janet_unwrap_number(value); + break; + case JANET_TARRAY_TYPE_U32: + array->as.u32[i] = (uint32_t) janet_unwrap_number(value); + break; + case JANET_TARRAY_TYPE_S32: + array->as.s32[i] = (int32_t) janet_unwrap_number(value); + break; +#ifdef JANET_INT_TYPES + case JANET_TARRAY_TYPE_U64: + array->as.u64[i] = janet_unwrap_u64(value); + break; + case JANET_TARRAY_TYPE_S64: + array->as.s64[i] = janet_unwrap_s64(value); + break; +#endif + case JANET_TARRAY_TYPE_F32: + array->as.f32[i] = (float) janet_unwrap_number(value); + break; + case JANET_TARRAY_TYPE_F64: + array->as.f64[i] = janet_unwrap_number(value); + break; + default: + janet_panicf("cannot set typed array of type %s", + ta_type_names[array->type]); + break; + } +} + +static Janet ta_view_next(void *p, Janet key) { + JanetTArrayView *view = p; + if (janet_checktype(key, JANET_NIL)) { + if (view->size > 0) { + return janet_wrap_number(0); + } else { + return janet_wrap_nil(); + } + } + if (!janet_checksize(key)) janet_panic("expected size as key"); + size_t index = (size_t) janet_unwrap_number(key); + index++; + if (index < view->size) { + return janet_wrap_number((double) index); + } + return janet_wrap_nil(); +} + +const JanetAbstractType janet_ta_view_type = { + "ta/view", + NULL, + ta_mark, + ta_getter, + ta_setter, + ta_view_marshal, + ta_view_unmarshal, + NULL, + NULL, + NULL, + ta_view_next, + JANET_ATEND_NEXT +}; + +JanetTArrayBuffer *janet_tarray_buffer(size_t size) { + JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer)); + ta_buffer_init(buf, size); + return buf; +} + +JanetTArrayView *janet_tarray_view( + JanetTArrayType type, + size_t size, + size_t stride, + size_t offset, + JanetTArrayBuffer *buffer) { + + JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView)); + + if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0"); + size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1); + + if (NULL == buffer) { + buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer)); + ta_buffer_init(buffer, buf_size); + } + + if (buffer->size < buf_size) { + janet_panicf("bad buffer size, %i bytes allocated < %i required", + buffer->size, + buf_size); + } + + view->buffer = buffer; + view->stride = stride; + view->size = size; + view->as.u8 = buffer->data + offset; + view->type = type; + + return view; +} + +JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) { + return janet_getabstract(argv, n, &janet_ta_buffer_type); +} + +JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) { + return janet_getabstract(argv, n, &janet_ta_view_type); +} + +JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) { + JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type); + if (view->type != type) { + janet_panicf("bad slot #%d, expected typed array of type %s, got %v", + n, ta_type_names[type], argv[n]); + } + return view; +} + +static Janet cfun_typed_array_new(int32_t argc, Janet *argv) { + janet_arity(argc, 2, 5); + size_t offset = 0; + size_t stride = 1; + JanetTArrayBuffer *buffer = NULL; + const uint8_t *keyw = janet_getkeyword(argv, 0); + JanetTArrayType type = get_ta_type_by_name(keyw); + size_t size = janet_getsize(argv, 1); + if (argc > 2) + stride = janet_getsize(argv, 2); + if (argc > 3) + offset = janet_getsize(argv, 3); + if (argc > 4) { + int32_t blen; + const uint8_t *bytes; + if (janet_bytes_view(argv[4], &bytes, &blen)) { + buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer)); + ta_buffer_init(buffer, (size_t) blen); + memcpy(buffer->data, bytes, blen); + } else { + if (!janet_checktype(argv[4], JANET_ABSTRACT)) { + janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v", + 4, argv[4]); + } + void *p = janet_unwrap_abstract(argv[4]); + if (janet_abstract_type(p) == &janet_ta_view_type) { + JanetTArrayView *view = (JanetTArrayView *)p; + offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type]; + stride *= view->stride; + buffer = view->buffer; + } else if (janet_abstract_type(p) == &janet_ta_buffer_type) { + buffer = p; + } else { + janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v", + 4, argv[4]); + } + } + } + JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer); + return janet_wrap_abstract(view); +} + +static JanetTArrayView *ta_is_view(Janet x) { + if (!janet_checktype(x, JANET_ABSTRACT)) return NULL; + void *abst = janet_unwrap_abstract(x); + if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL; + return (JanetTArrayView *)abst; +} + +static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + JanetTArrayView *view; + if ((view = ta_is_view(argv[0]))) { + return janet_wrap_abstract(view->buffer); + } + size_t size = janet_getsize(argv, 0); + JanetTArrayBuffer *buf = janet_tarray_buffer(size); + return janet_wrap_abstract(buf); +} + +static Janet cfun_typed_array_size(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + JanetTArrayView *view; + if ((view = ta_is_view(argv[0]))) { + return janet_wrap_number((double) view->size); + } + JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type); + return janet_wrap_number((double) buf->size); +} + +static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) { + janet_fixarity(argc, 1); + JanetTArrayView *view; + if ((view = ta_is_view(argv[0]))) { + JanetTArrayView *view = janet_unwrap_abstract(argv[0]); + JanetKV *props = janet_struct_begin(6); + ptrdiff_t boffset = view->as.u8 - view->buffer->data; + janet_struct_put(props, janet_ckeywordv("size"), + janet_wrap_number((double) view->size)); + janet_struct_put(props, janet_ckeywordv("byte-offset"), + janet_wrap_number((double) boffset)); + janet_struct_put(props, janet_ckeywordv("stride"), + janet_wrap_number((double) view->stride)); + janet_struct_put(props, janet_ckeywordv("type"), + janet_ckeywordv(ta_type_names[view->type])); + janet_struct_put(props, janet_ckeywordv("type-size"), + janet_wrap_number((double) ta_type_sizes[view->type])); + janet_struct_put(props, janet_ckeywordv("buffer"), + janet_wrap_abstract(view->buffer)); + return janet_wrap_struct(janet_struct_end(props)); + } else { + JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0); + JanetKV *props = janet_struct_begin(2); + janet_struct_put(props, janet_ckeywordv("size"), + janet_wrap_number((double) buffer->size)); + janet_struct_put(props, janet_ckeywordv("big-endian"), + janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN)); + return janet_wrap_struct(janet_struct_end(props)); + } +} + +static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) { + janet_arity(argc, 1, 3); + JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type); + JanetRange range; + int32_t length = (int32_t)src->size; + if (argc == 1) { + range.start = 0; + range.end = length; + } else if (argc == 2) { + range.start = janet_gethalfrange(argv, 1, length, "start"); + range.end = length; + } else { + range.start = janet_gethalfrange(argv, 1, length, "start"); + range.end = janet_gethalfrange(argv, 2, length, "end"); + if (range.end < range.start) + range.end = range.start; + } + JanetArray *array = janet_array(range.end - range.start); + if (array->data) { + for (int32_t i = range.start; i < range.end; i++) { + if (!ta_getter(src, janet_wrap_number(i), &array->data[i - range.start])) + array->data[i - range.start] = janet_wrap_nil(); + } + } + array->count = range.end - range.start; + return janet_wrap_array(array); +} + +static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) { + janet_arity(argc, 4, 5); + JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type); + size_t index_src = janet_getsize(argv, 1); + JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type); + size_t index_dst = janet_getsize(argv, 3); + if (index_src > src->size || index_dst > dst->size) { + janet_panic("invalid buffer index"); + } + size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1; + if (count > dst->size || count > src->size) { + janet_panic("typed array copy out of bounds"); + } + size_t src_atom_size = ta_type_sizes[src->type]; + size_t dst_atom_size = ta_type_sizes[dst->type]; + size_t step_src = src->stride * src_atom_size; + size_t step_dst = dst->stride * dst_atom_size; + size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src); + size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst); + uint8_t *ps = src->buffer->data + pos_src; + uint8_t *pd = dst->buffer->data + pos_dst; + if ((pos_dst + (count - 1) * step_dst + src_atom_size <= dst->buffer->size) && + (pos_src + (count - 1) * step_src + src_atom_size <= src->buffer->size)) { + for (size_t i = 0; i < count; i++) { + memmove(pd, ps, src_atom_size); + pd += step_dst; + ps += step_src; + } + } else { + janet_panic("typed array copy out of bounds"); + } + return janet_wrap_nil(); +} + +static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) { + janet_arity(argc, 4, 5); + JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type); + size_t index_src = janet_getsize(argv, 1); + JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type); + size_t index_dst = janet_getsize(argv, 3); + size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1; + size_t src_atom_size = ta_type_sizes[src->type]; + size_t dst_atom_size = ta_type_sizes[dst->type]; + size_t step_src = src->stride * src_atom_size; + size_t step_dst = dst->stride * dst_atom_size; + size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src); + size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst); + uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst; + uint8_t temp[TA_ATOM_MAXSIZE]; + if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) && + (pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) { + for (size_t i = 0; i < count; i++) { + memcpy(temp, ps, src_atom_size); + memcpy(ps, pd, src_atom_size); + memcpy(pd, temp, src_atom_size); + pd += step_dst; + ps += step_src; + } + } else { + janet_panic("typed array swap out of bounds"); + } + return janet_wrap_nil(); +} + +static const JanetReg ta_cfuns[] = { + { + "new", cfun_typed_array_new, + "(tarray/new type size &opt stride offset tarray|buffer)\n\n" + "Create new typed array." + }, + { + "buffer", cfun_typed_array_buffer, + "(tarray/buffer array|size)\n\n" + "Return typed array buffer or create a new buffer." + }, + { + "length", cfun_typed_array_size, + "(tarray/length array|buffer)\n\n" + "Return typed array or buffer size." + }, + { + "properties", cfun_typed_array_properties, + "(tarray/properties array)\n\n" + "Return typed array properties as a struct." + }, + { + "copy-bytes", cfun_typed_array_copy_bytes, + "(tarray/copy-bytes src sindex dst dindex &opt count)\n\n" + "Copy count elements (default 1) of src array from index sindex " + "to dst array at position dindex " + "memory can overlap." + }, + { + "swap-bytes", cfun_typed_array_swap_bytes, + "(tarray/swap-bytes src sindex dst dindex &opt count)\n\n" + "Swap count elements (default 1) between src array from index sindex " + "and dst array at position dindex " + "memory can overlap." + }, + { + "slice", cfun_typed_array_slice, + "(tarray/slice tarr &opt start end)\n\n" + "Takes a slice of a typed array from start to end. The range is half " + "open, [start, end). Indexes can also be negative, indicating indexing " + "from the end of the end of the typed array. By default, start is 0 and end is " + "the size of the typed array. Returns a new janet array." + }, + {NULL, NULL, NULL} +}; + +static JanetMethod tarray_view_methods[] = { + {"length", cfun_typed_array_size}, + {"properties", cfun_typed_array_properties}, + {"copy-bytes", cfun_typed_array_copy_bytes}, + {"swap-bytes", cfun_typed_array_swap_bytes}, + {"slice", cfun_typed_array_slice}, + {NULL, NULL} +}; + +/* Module entry point */ +JANET_MODULE_ENTRY(JanetTable *env) { + janet_cfuns(env, "tarray", ta_cfuns); + janet_register_abstract_type(&janet_ta_buffer_type); + janet_register_abstract_type(&janet_ta_view_type); +} diff --git a/src/tarray.h b/src/tarray.h new file mode 100644 index 0000000..d214a7f --- /dev/null +++ b/src/tarray.h @@ -0,0 +1,85 @@ +/* +* Copyright (c) 2021 Calvin Rose +* +* 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. +*/ + +#ifndef JANET_TYPED_ARRAYS_H_defined +#define JANET_TYPED_ARRAYS_H_defined + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +extern JANET_API const JanetAbstractType janet_ta_view_type; +extern JANET_API const JanetAbstractType janet_ta_buffer_type; + +typedef enum { + JANET_TARRAY_TYPE_U8, + JANET_TARRAY_TYPE_S8, + JANET_TARRAY_TYPE_U16, + JANET_TARRAY_TYPE_S16, + JANET_TARRAY_TYPE_U32, + JANET_TARRAY_TYPE_S32, + JANET_TARRAY_TYPE_U64, + JANET_TARRAY_TYPE_S64, + JANET_TARRAY_TYPE_F32, + JANET_TARRAY_TYPE_F64 +} JanetTArrayType; + +typedef struct { + uint8_t *data; + size_t size; + int32_t flags; +} JanetTArrayBuffer; + +typedef struct { + union { + void *pointer; + uint8_t *u8; + int8_t *s8; + uint16_t *u16; + int16_t *s16; + uint32_t *u32; + int32_t *s32; + uint64_t *u64; + int64_t *s64; + float *f32; + double *f64; + } as; + JanetTArrayBuffer *buffer; + size_t size; + size_t stride; + JanetTArrayType type; +} JanetTArrayView; + +JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size); +JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer); +JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type); +JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n); +JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type); +JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n); + +#ifdef __cplusplus +} +#endif + +#endif /* JANET_TYPED_ARRAYS_H_defined */ diff --git a/test/suite0014.janet b/test/suite0014.janet new file mode 100644 index 0000000..77f6819 --- /dev/null +++ b/test/suite0014.janet @@ -0,0 +1,30 @@ +(use spork/test) +(import spork/json :as json) + +(start-suite 14) + +(defn check-object [x] + (def y (json/decode (json/encode x))) + (def y1 (json/decode (json/encode x " " "\n"))) + (assert (deep= x y) (string/format "failed roundtrip 1: %p" x)) + (assert (deep= x y1) (string/format "failed roundtrip 2: %p" x))) + +(check-object 1) +(check-object 100) +(check-object true) +(check-object false) +(check-object (range 1000)) +(check-object @{"two" 2 "four" 4 "six" 6}) +(check-object @{"hello" "world"}) +(check-object @{"john" 1 "billy" "joe" "a" @[1 2 3 4 -1000]}) +(check-object @{"john" 1 "∀abcd" "joe" "a" @[1 2 3 4 -1000]}) +(check-object + "ᚠᛇᚻ᛫ᛒᛦᚦ᛫ᚠᚱᚩᚠᚢᚱ᛫ᚠᛁᚱᚪ᛫ᚷᛖᚻᚹᛦᛚᚳᚢᛗ +ᛋᚳᛖᚪᛚ᛫ᚦᛖᚪᚻ᛫ᛗᚪᚾᚾᚪ᛫ᚷᛖᚻᚹᛦᛚᚳ᛫ᛗᛁᚳᛚᚢᚾ᛫ᚻᛦᛏ᛫ᛞᚫᛚᚪᚾ +ᚷᛁᚠ᛫ᚻᛖ᛫ᚹᛁᛚᛖ᛫ᚠᚩᚱ᛫ᛞᚱᛁᚻᛏᚾᛖ᛫ᛞᚩᛗᛖᛋ᛫ᚻᛚᛇᛏᚪᚾ᛬") +(check-object @["šč"]) + +# Decoding utf-8 strings +(assert (deep= "šč" (json/decode `"šč"`)) "did not decode utf-8 string correctly") + +(end-suite) diff --git a/test/suite0015.janet b/test/suite0015.janet new file mode 100644 index 0000000..a6db09f --- /dev/null +++ b/test/suite0015.janet @@ -0,0 +1,83 @@ +(use ../spork/test) +(import spork/tarray) + +(start-suite 15) + +(defn inspect-tarray + [x] + (def a @[]) + (for i 0 (tarray/length x) (array/push a (x i))) + (pp a)) + +(assert-no-error + "create some typed arrays" + (do + (def a (tarray/new :float64 10)) + (def b (tarray/new :float64 5 2 0 a)) + (def c (tarray/new :uint32 20)))) + +(assert-no-error + "create some typed arrays from a buffer" + (do + (def buf (tarray/buffer (+ 64 (* (+ 1 (* (- 10 1) 2)) 8)))) + (def b (tarray/new :float64 10 2 64 buf)))) + +(def a (tarray/new :float64 10)) +(def b (tarray/new :float64 5 2 0 a)) + +(assert-no-error + "fill tarray" + (for i 0 (tarray/length a) + (set (a i) i))) + +(assert (= (tarray/buffer a) (tarray/buffer b)) "tarray views pointing same buffer") +(assert (= (a 2) (b 1) ) "tarray views pointing same buffer") +(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice") +(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice") +(assert (= (:length a) (length a)) "length method and function") + +(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal") + +# Janet issue 408 +(assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument") +(def ta (tarray/new :int32 10)) +(assert (= (next a nil) 0) "tarray next 1") +(assert (= (next a 0) 1) "tarray next 2") +(assert (= (next a 8) 9) "tarray next 3") +(assert (nil? (next a 9)) "tarray next 4") +(put ta 3 7) +(put ta 9 7) +(assert (= 2 (count |(= $ 7) ta)) "tarray count") + +# int64 typed arrays +(def i64 int/s64) +(def u64 int/u64) +(assert (let [t (tarray/new :int64 10) + b (i64 1000)] + (set (t 0) 1000) + (set (t 1) b) + (set (t 2) "1000") + (set (t 3) (t 0)) + (set (t 4) (u64 1000)) + (and + (= (t 0) (t 1)) + (= (t 1) (t 2)) + (= (t 2) (t 3)) + (= (t 3) (t 4)) + )) + "int64 typed arrays") + +# Janet Issue #142 + +(def buffer (tarray/buffer 8)) +(def buffer-float64-view (tarray/new :float64 1 1 0 buffer)) +(def buffer-uint32-view (tarray/new :uint32 2 1 0 buffer)) + +(set (buffer-uint32-view 1) 0xfffe9234) +(set (buffer-uint32-view 0) 0x56789abc) + +(assert (buffer-float64-view 0) "issue #142 nanbox hijack 1") +(assert (= (type (buffer-float64-view 0)) :number) "issue #142 nanbox hijack 2") +(assert (= (type (unmarshal @"\xC8\xbc\x9axV4\x92\xfe\xff")) :number) "issue #142 nanbox hijack 3") + +(end-suite)