Bruce/tomo
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Activity

Partially working first draft of bigints

Browse Source
This commit is contained in:
Bruce Hill 2024-08-13 01:30:25 -04:00
parent c1c889b024
commit d08f795794
24 changed files with 710 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -23,7 +23,7 @@ EXTRA=
G=-ggdb
O=-Og
CFLAGS=$(CCONFIG) $(EXTRA) $(CWARN) $(G) $(O) $(OSFLAGS)
LDLIBS=-lgc -lcord -lm -lunistring -ldl
LDLIBS=-lgc -lcord -lm -lunistring -lgmp -ldl
BUILTIN_OBJS=builtins/array.o builtins/bool.o builtins/channel.o builtins/nums.o builtins/functions.o builtins/integers.o \
builtins/pointer.o builtins/memory.o builtins/text.o builtins/thread.o builtins/where.o builtins/c_string.o builtins/table.o \
builtins/types.o builtins/util.o builtins/files.o builtins/range.o
@ -35,7 +35,7 @@ tomo: tomo.o $(BUILTIN_OBJS) SipHash/halfsiphash.o ast.o parse.o environment.o t
$(CC) $(CFLAGS) $(LDFLAGS) $^ $(LDLIBS) -o $@
libtomo.so: $(BUILTIN_OBJS) SipHash/halfsiphash.o
$(CC) $^ $(CFLAGS) $(EXTRA) $(CWARN) $(G) $(O) $(OSFLAGS) -lgc -lcord -lm -lunistring -ldl -Wl,-soname,libtomo.so -shared -o $@
$(CC) $^ $(CFLAGS) $(EXTRA) $(CWARN) $(G) $(O) $(OSFLAGS) -lgc -lcord -lm -lunistring -lgmp -ldl -Wl,-soname,libtomo.so -shared -o $@
SipHash/halfsiphash.c:
git submodule update --init --recursive

9
ast.c
View File

@ -5,6 +5,7 @@
#include <printf.h>
#include "ast.h"
#include "builtins/integers.h"
#include "builtins/text.h"
static const char *OP_NAMES[] = {
@ -34,9 +35,9 @@ static CORD optional_tagged_type(const char *tag, type_ast_t *ast);
CORD xml_escape(CORD text)
{
text = Text$replace(text, "&", "&amp;", INT64_MAX);
text = Text$replace(text, "<", "&lt;", INT64_MAX);
text = Text$replace(text, ">", "&gt;", INT64_MAX);
text = Text$replace(text, "&", "&amp;", I(-1));
text = Text$replace(text, "<", "&lt;", I(-1));
text = Text$replace(text, ">", "&gt;", I(-1));
return text;
}
@ -98,7 +99,7 @@ CORD ast_to_xml(ast_t *ast)
T(Nil, "<Nil>%r</Nil>", type_ast_to_xml(data.type))
T(Bool, "<Bool value=\"%s\" />", data.b ? "yes" : "no")
T(Var, "<Var>%s</Var>", data.name)
T(Int, "<Int bits=\"%ld\">%ld</Int>", data.bits, data.i)
T(Int, "<Int bits=\"%ld\">%s</Int>", data.bits, data.str)
T(Num, "<Num bits=\"%ld\">%g</Num>", data.bits, data.n)
T(TextLiteral, "%r", xml_escape(data.cord))
T(TextJoin, "<Text%r>%r</Text>", data.lang ? CORD_all(" lang=\"", data.lang, "\"") : CORD_EMPTY, ast_list_to_xml(data.children))

2
ast.h
View File

@ -143,7 +143,7 @@ struct ast_s {
const char *name;
} Var;
struct {
int64_t i;
const char *str;
int64_t bits;
} Int;
struct {

32
builtins/array.c
View File

@ -48,8 +48,9 @@ public void Array$compact(array_t *arr, int64_t padded_item_size)
};
}
public void Array$insert(array_t *arr, const void *item, int64_t index, int64_t padded_item_size)
public void Array$insert(array_t *arr, const void *item, Int_t int_index, int64_t padded_item_size)
{
int64_t index = Int$as_i64(int_index);
if (index <= 0) index = arr->length + index + 1;
if (index < 1) index = 1;
@ -79,8 +80,9 @@ public void Array$insert(array_t *arr, const void *item, int64_t index, int64_t
memcpy((void*)arr->data + (index-1)*padded_item_size, item, padded_item_size);
}
public void Array$insert_all(array_t *arr, array_t to_insert, int64_t index, int64_t padded_item_size)
public void Array$insert_all(array_t *arr, array_t to_insert, Int_t int_index, int64_t padded_item_size)
{
int64_t index = Int$as_i64(int_index);
if (to_insert.length == 0)
return;
@ -150,10 +152,12 @@ public void Array$insert_all(array_t *arr, array_t to_insert, int64_t index, int
}
}
public void Array$remove(array_t *arr, int64_t index, int64_t count, int64_t padded_item_size)
public void Array$remove(array_t *arr, Int_t int_index, Int_t int_count, int64_t padded_item_size)
{
int64_t index = Int$as_i64(int_index);
if (index < 1) index = arr->length + index + 1;
int64_t count = Int$as_i64(int_count);
if (index < 1 || index > (int64_t)arr->length || count < 1) return;
if (count > arr->length - index + 1)
@ -205,7 +209,7 @@ public void Array$shuffle(array_t *arr, int64_t padded_item_size)
char tmp[padded_item_size];
for (int64_t i = arr->length-1; i > 1; i--) {
int64_t j = Int$random(0, i);
int64_t j = arc4random_uniform(i+1);
memcpy(tmp, arr->data + i*padded_item_size, padded_item_size);
memcpy((void*)arr->data + i*padded_item_size, arr->data + j*padded_item_size, padded_item_size);
memcpy((void*)arr->data + j*padded_item_size, tmp, padded_item_size);
@ -216,7 +220,7 @@ public void *Array$random(array_t arr)
{
if (arr.length == 0)
return NULL; // fail("Cannot get a random item from an empty array!");
int64_t index = Int$random(0, arr.length-1);
int64_t index = arc4random_uniform(arr.length);
return arr.data + arr.stride*index;
}
@ -234,8 +238,9 @@ public table_t Array$counts(array_t arr, const TypeInfo *type)
return counts;
}
public array_t Array$sample(array_t arr, int64_t n, array_t weights, int64_t padded_item_size)
public array_t Array$sample(array_t arr, Int_t int_n, array_t weights, int64_t padded_item_size)
{
int64_t n = Int$as_i64(int_n);
if (arr.length == 0 || n <= 0)
return (array_t){};
@ -262,7 +267,7 @@ public array_t Array$sample(array_t arr, int64_t n, array_t weights, int64_t pad
if (total == 0.0) {
for (int64_t i = 0; i < n; i++) {
int64_t index = Int$random(0, arr.length-1);
int64_t index = arc4random_uniform(arr.length);
memcpy(selected.data + i*padded_item_size, arr.data + arr.stride*index, padded_item_size);
}
} else {
@ -312,8 +317,9 @@ public array_t Array$sample(array_t arr, int64_t n, array_t weights, int64_t pad
return selected;
}
public array_t Array$from(array_t array, int64_t first)
public array_t Array$from(array_t array, Int_t int_first)
{
int64_t first = Int$as_i64(int_first);
if (first < 0)
first = array.length + first + 1;
@ -329,8 +335,9 @@ public array_t Array$from(array_t array, int64_t first)
};
}
public array_t Array$to(array_t array, int64_t last)
public array_t Array$to(array_t array, Int_t int_last)
{
int64_t last = Int$as_i64(int_last);
if (last < 0)
last = array.length + last + 1;
@ -349,8 +356,9 @@ public array_t Array$to(array_t array, int64_t last)
};
}
public array_t Array$by(array_t array, int64_t stride, int64_t padded_item_size)
public array_t Array$by(array_t array, Int_t int_stride, int64_t padded_item_size)
{
int64_t stride = Int$as_i64(int_stride);
// In the unlikely event that the stride value would be too large to fit in
// a 15-bit integer, fall back to creating a copy of the array:
if (__builtin_expect(array.stride*stride < ARRAY_MIN_STRIDE || array.stride*stride > ARRAY_MAX_STRIDE, 0)) {
@ -389,7 +397,7 @@ public array_t Array$reversed(array_t array, int64_t padded_item_size)
// the array. This should only happen if array.stride is MIN_STRIDE to
// begin with (very unlikely).
if (__builtin_expect(-array.stride < ARRAY_MIN_STRIDE || -array.stride > ARRAY_MAX_STRIDE, 0))
return Array$by(array, -1, padded_item_size);
return Array$by(array, I(-1), padded_item_size);
array_t reversed = array;
reversed.stride = -array.stride;
@ -584,7 +592,7 @@ static void siftup(array_t *heap, int64_t pos, closure_t comparison, int64_t pad
public void Array$heap_push(array_t *heap, const void *item, closure_t comparison, int64_t padded_item_size)
{
Array$insert(heap, item, 0, padded_item_size);
Array$insert(heap, item, I(0), padded_item_size);
if (heap->length > 1) {
if (heap->data_refcount != 0)

25
builtins/array.h
View File

@ -7,27 +7,28 @@
#include "datatypes.h"
#include "functions.h"
#include "integers.h"
#include "types.h"
#include "util.h"
// Convert negative indices to back-indexed without branching: index0 = index + (index < 0)*(len+1)) - 1
#define Array_get(item_type, arr_expr, index_expr, filename, start, end) *({ \
const array_t arr = arr_expr; int64_t index = (int64_t)(index_expr); \
const array_t arr = arr_expr; int64_t index = Int$as_i64(index_expr); \
int64_t off = index + (index < 0) * (arr.length + 1) - 1; \
if (__builtin_expect(off < 0 || off >= arr.length, 0)) \
fail_source(filename, start, end, "Invalid array index: %r (array has length %ld)\n", Int$as_text(&index, no, NULL), arr.length); \
fail_source(filename, start, end, "Invalid array index: %r (array has length %ld)\n", Int64$as_text(&index, no, NULL), arr.length); \
(item_type*)(arr.data + arr.stride * off);})
#define Array_lvalue(item_type, arr_expr, index_expr, padded_item_size, filename, start, end) *({ \
array_t *arr = arr_expr; int64_t index = (int64_t)(index_expr); \
array_t *arr = arr_expr; int64_t index = Int$as_i64(index_expr); \
int64_t off = index + (index < 0) * (arr->length + 1) - 1; \
if (__builtin_expect(off < 0 || off >= arr->length, 0)) \
fail_source(filename, start, end, "Invalid array index: %r (array has length %ld)\n", Int$as_text(&index, no, NULL), arr->length); \
fail_source(filename, start, end, "Invalid array index: %r (array has length %ld)\n", Int64$as_text(&index, no, NULL), arr->length); \
if (arr->data_refcount > 0) \
Array$compact(arr, padded_item_size); \
(item_type*)(arr->data + arr->stride * off); })
#define Array_set(item_type, arr, index, value, padded_item_size, filename, start, end) \
Array_lvalue(item_type, arr_expr, index, padded_item_size, filename, start, end) = value
#define Array_get_unchecked(type, x, i) *({ const array_t arr = x; int64_t index = (int64_t)(i); \
#define Array_get_unchecked(type, x, i) *({ const array_t arr = x; int64_t index = I(i); \
int64_t off = index + (index < 0) * (arr.length + 1) - 1; \
(type*)(arr.data + arr.stride * off);})
#define is_atomic(x) _Generic(x, bool: true, int8_t: true, int16_t: true, int32_t: true, int64_t: true, float: true, double: true, default: false)
@ -55,22 +56,22 @@
#define ARRAY_COPY(arr) ({ ARRAY_INCREF(arr); arr; })
#define Array$insert_value(arr, item_expr, index, padded_item_size) ({ __typeof(item_expr) item = item_expr; Array$insert(arr, &item, index, padded_item_size); })
void Array$insert(array_t *arr, const void *item, int64_t index, int64_t padded_item_size);
void Array$insert_all(array_t *arr, array_t to_insert, int64_t index, int64_t padded_item_size);
void Array$remove(array_t *arr, int64_t index, int64_t count, int64_t padded_item_size);
void Array$insert(array_t *arr, const void *item, Int_t index, int64_t padded_item_size);
void Array$insert_all(array_t *arr, array_t to_insert, Int_t index, int64_t padded_item_size);
void Array$remove(array_t *arr, Int_t index, Int_t count, int64_t padded_item_size);
void Array$sort(array_t *arr, closure_t comparison, int64_t padded_item_size);
array_t Array$sorted(array_t arr, closure_t comparison, int64_t padded_item_size);
void Array$shuffle(array_t *arr, int64_t padded_item_size);
void *Array$random(array_t arr);
#define Array$random_value(arr, t) ({ array_t _arr = arr; if (_arr.length == 0) fail("Cannot get a random value from an empty array!"); *(t*)Array$random(_arr); })
array_t Array$sample(array_t arr, int64_t n, array_t weights, int64_t padded_item_size);
array_t Array$sample(array_t arr, Int_t n, array_t weights, int64_t padded_item_size);
table_t Array$counts(array_t arr, const TypeInfo *type);
void Array$clear(array_t *array);
void Array$compact(array_t *arr, int64_t padded_item_size);
bool Array$contains(array_t array, void *item, const TypeInfo *type);
array_t Array$from(array_t array, int64_t first);
array_t Array$to(array_t array, int64_t last);
array_t Array$by(array_t array, int64_t stride, int64_t padded_item_size);
array_t Array$from(array_t array, Int_t first);
array_t Array$to(array_t array, Int_t last);
array_t Array$by(array_t array, Int_t stride, int64_t padded_item_size);
array_t Array$reversed(array_t array, int64_t padded_item_size);
array_t Array$concat(array_t x, array_t y, int64_t padded_item_size);
uint32_t Array$hash(const array_t *arr, const TypeInfo *type);

8
builtins/channel.c
View File

@ -34,7 +34,7 @@ public void Channel$push(channel_t *channel, const void *item, int64_t padded_it
(void)pthread_mutex_lock(&channel->mutex);
while (channel->items.length >= channel->max_size)
pthread_cond_wait(&channel->cond, &channel->mutex);
Array$insert(&channel->items, item, 0, padded_item_size);
Array$insert(&channel->items, item, I(0), padded_item_size);
(void)pthread_mutex_unlock(&channel->mutex);
(void)pthread_cond_signal(&channel->cond);
}
@ -47,10 +47,10 @@ public void Channel$push_all(channel_t *channel, array_t to_push, int64_t padded
for (int64_t i = 0; i < to_push.length; i++) {
while (channel->items.length >= channel->max_size)
pthread_cond_wait(&channel->cond, &channel->mutex);
Array$insert(&channel->items, to_push.data + i*to_push.stride, 0, padded_item_size);
Array$insert(&channel->items, to_push.data + i*to_push.stride, I(0), padded_item_size);
}
} else {
Array$insert_all(&channel->items, to_push, 0, padded_item_size);
Array$insert_all(&channel->items, to_push, I(0), padded_item_size);
}
(void)pthread_mutex_unlock(&channel->mutex);
(void)pthread_cond_signal(&channel->cond);
@ -62,7 +62,7 @@ public void Channel$pop(channel_t *channel, void *out, int64_t item_size, int64_
while (channel->items.length == 0)
pthread_cond_wait(&channel->cond, &channel->mutex);
memcpy(out, channel->items.data, item_size);
Array$remove(&channel->items, 1, 1, padded_item_size);
Array$remove(&channel->items, I(1), I(1), padded_item_size);
(void)pthread_mutex_unlock(&channel->mutex);
(void)pthread_cond_signal(&channel->cond);
}

8
builtins/datatypes.h
View File

@ -2,6 +2,7 @@
// Common datastructures (arrays, tables, closures)
#include <gmp.h>
#include <stdint.h>
#include <stdbool.h>
#include <pthread.h>
@ -17,6 +18,11 @@
#define ARRAY_MAX_DATA_REFCOUNT MAX_FOR_N_BITS(ARRAY_REFCOUNT_BITS)
#define ARRAY_MAX_FREE_ENTRIES MAX_FOR_N_BITS(ARRAY_FREE_BITS)
typedef union {
int64_t small;
mpz_t *big;
} Int_t;
typedef struct {
void *data;
// All of the following fields add up to 64 bits, which means that array
@ -55,7 +61,7 @@ typedef struct {
} closure_t;
typedef struct Range_s {
int64_t first, last, step;
Int_t first, last, step;
} Range_t;
typedef struct {

2
builtins/functions.c
View File

@ -17,6 +17,7 @@
#include "files.h"
#include "functions.h"
#include "halfsiphash.h"
#include "integers.h"
#include "pointer.h"
#include "string.h"
#include "table.h"
@ -35,6 +36,7 @@ public void tomo_init(void)
getrandom(&seed, sizeof(seed), 0);
srand(seed);
srand48(seed);
Int$init_random(seed);
}
static void print_stack_trace(FILE *out)

300
builtins/integers.c
View File

@ -1,6 +1,7 @@
// Integer type infos and methods
#include <gc.h>
#include <gc/cord.h>
#include <gmp.h>
#include <stdbool.h>
#include <stdint.h>
#include <stdlib.h>
@ -8,11 +9,300 @@
#include "array.h"
#include "datatypes.h"
#include "integers.h"
#include "string.h"
#include "text.h"
#include "types.h"
#include "SipHash/halfsiphash.h"
static gmp_randstate_t Int_rng = {};
public void Int$init_random(long seed)
{
gmp_randinit_default(Int_rng);
gmp_randseed_ui(Int_rng, (unsigned long)seed);
}
public Int_t Int$from_i64(int64_t i)
{
if (i == (int32_t)i) return (Int_t){.small=(i*4)+1};
mpz_t result;
mpz_init_set_si(result, i);
return Int$from_mpz(result);
}
public CORD Int$as_text(const Int_t *i, bool colorize, const TypeInfo *type) {
(void)type;
if (!i) return "Int";
if (__builtin_expect(i->small & 1, 1)) {
return CORD_asprintf(colorize ? "\x1b[35m%ld\x1b[33;2m\x1b[m" : "%ld", (i->small)>>2);
} else {
char *str = mpz_get_str(NULL, 10, *i->big);
return CORD_asprintf(colorize ? "\x1b[35m%s\x1b[33;2m\x1b[m" : "%s", str);
}
}
public int32_t Int$compare(const Int_t *x, const Int_t *y, const TypeInfo *type) {
(void)type;
if (__builtin_expect(((x->small & y->small) & 1) == 0, 0))
return mpz_cmp(*x->big, *y->big);
return (x->small > y->small) - (x->small < y->small);
}
public int32_t Int$compare_value(const Int_t x, const Int_t y) {
if (__builtin_expect(((x.small & y.small) & 1) == 0, 0))
return mpz_cmp(*x.big, *y.big);
return (x.small > y.small) - (x.small < y.small);
}
public bool Int$equal(const Int_t *x, const Int_t *y, const TypeInfo *type) {
(void)type;
return x->small == y->small || (__builtin_expect(((x->small & y->small) & 1) == 0, 0) && mpz_cmp(*x->big, *y->big) == 0);
}
public bool Int$equal_value(const Int_t x, const Int_t y) {
return x.small == y.small || (__builtin_expect(((x.small & y.small) & 1) == 0, 0) && mpz_cmp(*x.big, *y.big) == 0);
}
public bool Int$hash(const Int_t *x, const TypeInfo *type) {
(void)type;
uint32_t hash;
if (__builtin_expect(x->small & 1, 1)) {
halfsiphash(&x->small, sizeof(x->small), TOMO_HASH_KEY, (uint8_t*)&hash, sizeof(hash));
} else {
char *str = mpz_get_str(NULL, 16, *x->big);
halfsiphash(str, strlen(str), TOMO_HASH_KEY, (uint8_t*)&hash, sizeof(hash));
}
return hash;
}
public CORD Int$hex(Int_t i, int64_t digits, bool uppercase, bool prefix) {
const char *hex_fmt = uppercase ? (prefix ? "0x%0.*lX" : "%0.*lX") : (prefix ? "0x%0.*lx" : "%0.*lx");
if (__builtin_expect(i.small & 1, 1)) {
return CORD_asprintf(hex_fmt, (i.small)>>2);
} else {
CORD str = mpz_get_str(NULL, 16, *i.big);
if (uppercase) str = Text$upper(str);
if (digits > (int64_t)CORD_len(str))
str = CORD_cat(str, CORD_chars('0', digits - CORD_len(str)));
if (prefix) str = CORD_cat("0x", str);
return str;
}
}
public CORD Int$octal(Int_t i, int64_t digits, bool prefix) {
const char *octal_fmt = prefix ? "0o%0.*lo" : "%0.*lo";
if (__builtin_expect(i.small & 1, 1)) {
return CORD_asprintf(octal_fmt, (int)digits, (uint64_t)(i.small >> 2));
} else {
CORD str = mpz_get_str(NULL, 8, *i.big);
if (digits > (int64_t)CORD_len(str))
str = CORD_cat(str, CORD_chars('0', digits - CORD_len(str)));
if (prefix) str = CORD_cat("0o", str);
return str;
}
}
public Int_t Int$slow_plus(Int_t x, Int_t y) {
mpz_t result;
mpz_init_set_int(result, x);
if (y.small & 1) {
mpz_t y_mpz;
mpz_init_set_int(y_mpz, y);
mpz_add(result, result, y_mpz);
} else {
mpz_add(result, result, *y.big);
}
return Int$from_mpz(result);
}
public Int_t Int$slow_minus(Int_t x, Int_t y) {
mpz_t result;
mpz_init_set_int(result, x);
if (y.small & 1) {
mpz_t y_mpz;
mpz_init_set_int(y_mpz, y);
mpz_sub(result, result, y_mpz);
} else {
mpz_sub(result, result, *y.big);
}
return Int$from_mpz(result);
}
public Int_t Int$slow_times(Int_t x, Int_t y) {
mpz_t result;
mpz_init_set_int(result, x);
if (y.small & 1) {
mpz_t y_mpz;
mpz_init_set_int(y_mpz, y);
mpz_mul(result, result, y_mpz);
} else {
mpz_mul(result, result, *y.big);
}
return Int$from_mpz(result);
}
public Int_t Int$slow_divided_by(Int_t x, Int_t y) {
mpz_t result;
mpz_init_set_int(result, x);
if (y.small & 1) {
mpz_t y_mpz;
mpz_init_set_int(y_mpz, y);
mpz_cdiv_q(result, result, y_mpz);
} else {
mpz_cdiv_q(result, result, *y.big);
}
return Int$from_mpz(result);
}
public Int_t Int$slow_modulo(Int_t x, Int_t modulus)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_t divisor;
mpz_init_set_int(divisor, modulus);
mpz_mod(result, result, divisor);
return Int$from_mpz(result);
}
public Int_t Int$slow_modulo1(Int_t x, Int_t modulus)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_sub_ui(result, result, 1);
mpz_t divisor;
mpz_init_set_int(divisor, modulus);
mpz_mod(result, result, divisor);
mpz_add_ui(result, result, 1);
return Int$from_mpz(result);
}
public Int_t Int$slow_left_shifted(Int_t x, Int_t y)
{
mp_bitcnt_t bits = (mp_bitcnt_t)Int$as_i64(y);
mpz_t result;
mpz_init_set_int(result, x);
mpz_mul_2exp(result, result, bits);
return Int$from_mpz(result);
}
public Int_t Int$slow_right_shifted(Int_t x, Int_t y)
{
mp_bitcnt_t bits = (mp_bitcnt_t)Int$as_i64(y);
mpz_t result;
mpz_init_set_int(result, x);
mpz_tdiv_q_2exp(result, result, bits);
return Int$from_mpz(result);
}
public Int_t Int$slow_bit_and(Int_t x, Int_t y)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_t y_mpz;
mpz_init_set_int(y_mpz, y);
mpz_and(result, result, y_mpz);
return Int$from_mpz(result);
}
public Int_t Int$slow_bit_or(Int_t x, Int_t y)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_t y_mpz;
mpz_init_set_int(y_mpz, y);
mpz_ior(result, result, y_mpz);
return Int$from_mpz(result);
}
public Int_t Int$slow_bit_xor(Int_t x, Int_t y)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_t y_mpz;
mpz_init_set_int(y_mpz, y);
mpz_xor(result, result, y_mpz);
return Int$from_mpz(result);
}
public Int_t Int$slow_negated(Int_t x)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_neg(result, result);
mpz_sub_ui(result, result, 1);
return Int$from_mpz(result);
}
public Int_t Int$slow_negative(Int_t x)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_neg(result, result);
return Int$from_mpz(result);
}
public Int_t Int$slow_abs(Int_t x)
{
mpz_t result;
mpz_init_set_int(result, x);
mpz_abs(result, result);
return Int$from_mpz(result);
}
public Int_t Int$random(Int_t min, Int_t max) {
int32_t cmp = Int$compare(&min, &max, &$Int);
if (cmp > 0)
fail("Random minimum value (%r) is larger than the maximum value (%r)",
Int$as_text(&min, false, &$Int), Int$as_text(&max, false, &$Int));
if (cmp == 0) return min;
mpz_t range_size;
mpz_init_set_int(range_size, max);
if (min.small & 1) {
mpz_t min_mpz;
mpz_init_set_si(min_mpz, min.small >> 2);
mpz_sub(range_size, range_size, min_mpz);
} else {
mpz_sub(range_size, range_size, *min.big);
}
mpz_t r;
mpz_init(r);
mpz_urandomm(r, Int_rng, range_size);
return Int$plus(min, Int$from_mpz(r));
}
public Range_t Int$to(Int_t from, Int_t to) {
return (Range_t){from, to, Int$compare(&to, &from, &$Int) >= 0 ? (Int_t){.small=(1<<2)|1} : (Int_t){.small=(-1/4)|1}};
}
public Int_t Int$from_text(CORD text) {
const char *str = CORD_to_const_char_star(text);
mpz_t i;
if (strncmp(str, "0x", 2) == 0) {
mpz_init_set_str(i, str + 2, 16);
} else if (strncmp(str, "0o", 2) == 0) {
mpz_init_set_str(i, str + 2, 8);
} else if (strncmp(str, "0b", 2) == 0) {
mpz_init_set_str(i, str + 2, 2);
} else {
mpz_init_set_str(i, str, 10);
}
return Int$from_mpz(i);
}
public const TypeInfo $Int = {
.size=sizeof(Int_t),
.align=__alignof__(Int_t),
.tag=CustomInfo,
.CustomInfo={
.compare=(void*)Int$compare,
.equal=(void*)Int$equal,
.hash=(void*)Int$equal,
.as_text=(void*)Int$as_text,
},
};
#define xstr(a) str(a)
#define str(a) #a
#define DEFINE_INT_TYPE(c_type, KindOfInt, fmt, min_val, max_val)\
public CORD KindOfInt ## $as_text(const c_type *i, bool colorize, const TypeInfo *type) { \
@ -69,7 +359,7 @@
return (c_type)((uint64_t)min + (r % range)); \
} \
public Range_t KindOfInt ## $to(c_type from, c_type to) { \
return (Range_t){from, to, to >= from ? 1 : -1}; \
return (Range_t){Int$from_i64(from), Int$from_i64(to), to >= from ? (Int_t){.small=(1<<2)&1} : (Int_t){.small=(1<<2)&1}}; \
} \
public c_type KindOfInt ## $from_text(CORD text, CORD *the_rest) { \
const char *str = CORD_to_const_char_star(text); \
@ -98,7 +388,7 @@
.CustomInfo={.compare=(void*)KindOfInt##$compare, .as_text=(void*)KindOfInt##$as_text}, \
};
DEFINE_INT_TYPE(int64_t, Int, "ld", INT64_MIN, INT64_MAX);
DEFINE_INT_TYPE(int64_t, Int64, "ld", INT64_MIN, INT64_MAX);
DEFINE_INT_TYPE(int32_t, Int32, "d_i32", INT32_MIN, INT32_MAX);
DEFINE_INT_TYPE(int16_t, Int16, "d_i16", INT16_MIN, INT16_MAX);
DEFINE_INT_TYPE(int8_t, Int8, "d_i8", INT8_MIN, INT8_MAX);

113
builtins/integers.h
View File

@ -6,11 +6,12 @@
#include <stdbool.h>
#include <stdint.h>
#include <stdlib.h>
#include <gmp.h>
#include "datatypes.h"
#include "types.h"
#define Int_t int64_t
#define Int64_t int64_t
#define Int32_t int32_t
#define Int16_t int16_t
#define Int8_t int8_t
@ -33,15 +34,121 @@
extern const c_type type_name ## $min, type_name##$max; \
extern const TypeInfo $ ## type_name;
DEFINE_INT_TYPE(int64_t, Int);
DEFINE_INT_TYPE(int64_t, Int64);
DEFINE_INT_TYPE(int32_t, Int32);
DEFINE_INT_TYPE(int16_t, Int16);
DEFINE_INT_TYPE(int8_t, Int8);
#undef DEFINE_INT_TYPE
#define Int$abs(...) I64(labs(__VA_ARGS__))
#define Int64$abs(...) I64(labs(__VA_ARGS__))
#define Int32$abs(...) I32(abs(__VA_ARGS__))
#define Int16$abs(...) I16(abs(__VA_ARGS__))
#define Int8$abs(...) I8(abs(__VA_ARGS__))
CORD Int$as_text(const Int_t *i, bool colorize, const TypeInfo *type);
int32_t Int$compare(const Int_t *x, const Int_t *y, const TypeInfo *type);
int32_t Int$compare_value(const Int_t x, const Int_t y);
bool Int$equal(const Int_t *x, const Int_t *y, const TypeInfo *type);
bool Int$equal_value(const Int_t x, const Int_t y);
CORD Int$format(Int_t i, int64_t digits);
CORD Int$hex(Int_t i, int64_t digits, bool uppercase, bool prefix);
CORD Int$octal(Int_t i, int64_t digits, bool prefix);
void Int$init_random(long seed);
Int_t Int$random(Int_t min, Int_t max);
Range_t Int$to(Int_t from, Int_t to);
Int_t Int$from_text(CORD text);
Int_t Int$abs(Int_t x);
#define BIGGEST_SMALL_INT ((1<<30)-1)
#define Int$from_mpz(mpz) (\
mpz_cmpabs_ui(mpz, BIGGEST_SMALL_INT) <= 0 ? ({ \
(Int_t){.small=(mpz_get_si(mpz)<<2)|1}; \
}) : ({ \
mpz_t *result_obj = new(mpz_t); \
memcpy(result_obj, &mpz, sizeof(mpz_t)); \
(Int_t){.big=result_obj}; \
}))
#define mpz_init_set_int(mpz, i) do { \
if ((i).small & 1) mpz_init_set_si(mpz, (i).small >> 2); \
else mpz_init_set(mpz, *(i).big); \
} while (0)
#define Int$as_i64(i) (((i).small & 1) ? (int64_t)((i).small >> 2) : mpz_get_si(*(i).big))
Int_t Int$from_i64(int64_t i);
#define I(i) ((int64_t)(i) == (int32_t)(i) ? ((Int_t){.small=((uint64_t)(i)<<2)|1}) : Int$from_i64(i))
Int_t Int$slow_plus(Int_t x, Int_t y);
Int_t Int$slow_minus(Int_t x, Int_t y);
Int_t Int$slow_times(Int_t x, Int_t y);
Int_t Int$slow_divided_by(Int_t x, Int_t y);
Int_t Int$slow_modulo(Int_t x, Int_t y);
Int_t Int$slow_modulo1(Int_t x, Int_t y);
Int_t Int$slow_left_shifted(Int_t x, Int_t y);
Int_t Int$slow_right_shifted(Int_t x, Int_t y);
Int_t Int$slow_bit_and(Int_t x, Int_t y);
Int_t Int$slow_bit_or(Int_t x, Int_t y);
Int_t Int$slow_bit_xor(Int_t x, Int_t y);
Int_t Int$slow_negative(Int_t x);
Int_t Int$slow_negated(Int_t x);
Int_t Int$slow_abs(Int_t x);
#define Int$plus(_x, _y) ({ \
Int_t x = _x, y = _y; \
const int64_t z = (int64_t)((uint64_t)x.small + (uint64_t)y.small); \
__builtin_expect(((z|2) != (int32_t)z), 0) ? Int$slow_plus(x, y) : (Int_t){.small=(z-1)}; })
#define Int$minus(_x, _y) ({ \
Int_t x = _x, y = _y; \
const int64_t z = (int64_t)(((uint64_t)x.small ^ 3) - (uint64_t)y.small); \
__builtin_expect(((z & ~2) != (int32_t)z), 0) ? Int$slow_minus(x, y) : (Int_t){.small=(z-1)}; })
#define Int$times(_x, _y) ({ \
Int_t x = _x, y = _y; \
__builtin_expect(((x.small & y.small) & 1) == 0, 0) ? Int$slow_times(x, y) : ({ \
const int64_t z = (x.small>>1) * (y.small>>1); \
__builtin_expect(z != (int32_t)z, 0) ? Int$slow_times(x, y) : (Int_t){.small=z+1}; }); })
#define Int$divided_by(_x, _y) ({ \
Int_t x = _x, y = _y; \
__builtin_expect(((x.small & y.small) & 1) == 0, 0) ? Int$slow_divided_by(x, y) : ({ \
const int64_t z = 4*(x.small>>1) / (y.small>>1); \
__builtin_expect(z != (int32_t)z, 0) ? Int$slow_divided_by(x, y) : (Int_t){.small=z+1}; }); })
#define Int$left_shifted(_x, _y) ({ \
Int_t x = _x, y = _y; \
__builtin_expect(((x.small & y.small) & 1) == 0, 0) ? Int$slow_left_shifted(x, y) : ({ \
const int64_t z = 4*((x.small>>2) << (y.small>>2)); \
__builtin_expect(z != (int32_t)z, 0) ? Int$slow_left_shifted(x, y) : (Int_t){.small=z+1}; }); })
#define Int$right_shifted(_x, _y) ({ \
Int_t x = _x, y = _y; \
__builtin_expect(((x.small & y.small) & 1) == 0, 0) ? Int$slow_right_shifted(x, y) : ({ \
const int64_t z = 4*((x.small>>2) >> (y.small>>2)); \
__builtin_expect(z != (int32_t)z, 0) ? Int$slow_right_shifted(x, y) : (Int_t){.small=z+1}; }); })
#define Int$bit_and(_x, _y) ({ \
Int_t x = _x, y = _y; \
const int64_t z = x.small & y.small; \
__builtin_expect((z & 1) == 1, 1) ? (Int_t){.small=z} : Int$slow_bit_and(x, y); })
#define Int$bit_or(_x, _y) ({ \
Int_t x = _x, y = _y; \
__builtin_expect(((x.small & y.small) & 1) == 1, 1) ? (Int_t){.small=(x.small | y.small)} : Int$slow_bit_or(x, y); })
#define Int$bit_xor(_x, _y) ({ \
Int_t x = _x, y = _y; \
__builtin_expect(((x.small & y.small) & 1) == 1, 1) ? (Int_t){.small=(x.small ^ y.small) | 1} : Int$slow_bit_xor(x, y); })
#define Int$modulo(x, y) Int$slow_modulo(x, y)
#define Int$modulo1(x, y) Int$slow_modulo1(x, y)
#define Int$negative(_x) ({ \
Int_t x = _x; \
__builtin_expect((x.small & 1), 1) ? (Int_t){.small=4*-((x.small)/4) + 1} : Int$slow_negative(x); })
#define Int$negated(_x) ({ \
Int_t x = _x; \
__builtin_expect((x.small & 1), 1) ? (Int_t){.small=(~x.small) ^ 3} : Int$slow_negated(x); })
#define Int$abs(_x) ({ \
Int_t x = _x; \
__builtin_expect((x.small & 1), 1) ? (Int_t){.small=4*labs((x.small)/4) + 1} : Int$slow_abs(x); })
extern const TypeInfo $Int;
// vim: ts=4 sw=0 et cino=L2,l1,(0,W4,m1,\:0

22
builtins/range.c
View File

@ -2,6 +2,7 @@
#include <ctype.h>
#include <err.h>
#include <gmp.h>
#include <gc.h>
#include <gc/cord.h>
#include <math.h>
@ -11,23 +12,24 @@
#include <sys/param.h>
#include "types.h"
#include "integers.h"
#include "util.h"
static int32_t Range$compare(const Range_t *x, const Range_t *y, const TypeInfo *type)
{
(void)type;
int32_t diff = (x->first > y->first) - (x->first < y->first);
int32_t diff = Int$compare(&x->first, &y->first, &$Int);
if (diff != 0) return diff;
diff = (x->last > y->last) - (x->last < y->last);
diff = Int$compare(&x->last, &y->last, &$Int);
if (diff != 0) return diff;
return (x->step > y->step) - (x->step < y->step);
return Int$compare(&x->step, &y->step, &$Int);
}
static bool Range$equal(const Range_t *x, const Range_t *y, const TypeInfo *type)
{
(void)type;
return (x->first == y->first) && (x->last == y->last) && (x->step == y->step);
return Int$equal(&x->first, &y->first, &$Int) && Int$equal(&x->last, &y->last, &$Int) && Int$equal(&x->step, &y->step, &$Int);
}
static CORD Range$as_text(const Range_t *r, bool use_color, const TypeInfo *type)
@ -35,18 +37,20 @@ static CORD Range$as_text(const Range_t *r, bool use_color, const TypeInfo *type
(void)type;
if (!r) return "Range";
return CORD_asprintf(use_color ? "\x1b[0;1mRange\x1b[m(first=\x1b[35m%ld\x1b[m, last=\x1b[35m%ld\x1b[m, step=\x1b[35m%ld\x1b[m)"
: "Range(first=%ld, last=%ld, step=%ld)", r->first, r->last, r->step);
return CORD_asprintf(use_color ? "\x1b[0;1mRange\x1b[m(first=%r, last=%r, step=%r)"
: "Range(first=%r, last=%r, step=%r)",
Int$as_text(&r->first, use_color, &$Int), Int$as_text(&r->last, use_color, &$Int),
Int$as_text(&r->step, use_color, &$Int));
}
public Range_t Range$reversed(Range_t r)
{
return (Range_t){r.last, r.first, -r.step};
return (Range_t){r.last, r.first, Int$negative(r.step)};
}
public Range_t Range$by(Range_t r, int64_t step)
public Range_t Range$by(Range_t r, Int_t step)
{
return (Range_t){r.first, r.last, step*r.step};
return (Range_t){r.first, r.last, Int$times(step, r.step)};
}
public const TypeInfo Range = {sizeof(Range_t), __alignof(Range_t), {.tag=CustomInfo, .CustomInfo={

4
builtins/table.c
View File

@ -267,7 +267,7 @@ public void *Table$reserve(table_t *t, const void *key, const void *value, const
memcpy(buf + value_offset(type), value, value_size);
else
memset(buf + value_offset(type), 0, value_size);
Array$insert(&t->entries, buf, 0, entry_size(type));
Array$insert(&t->entries, buf, I(0), entry_size(type));
int64_t entry_index = t->entries.length-1;
void *entry = GET_ENTRY(*t, entry_index);
@ -350,7 +350,7 @@ public void Table$remove(table_t *t, const void *key, const TypeInfo *type)
// Last entry is being removed, so clear it out to be safe:
memset(GET_ENTRY(*t, last_entry), 0, entry_size(type));
Array$remove(&t->entries, t->entries.length, 1, entry_size(type));
Array$remove(&t->entries, I(t->entries.length), I(1), entry_size(type));
int64_t bucket_to_clear;
if (prev) { // Middle (or end) of a chain

21
builtins/text.c
View File

@ -5,6 +5,7 @@
#include <err.h>
#include <gc.h>
#include <gc/cord.h>
#include <gmp.h>
#include <limits.h>
#include <stdbool.h>
#include <stdint.h>
@ -19,6 +20,7 @@
#include "array.h"
#include "functions.h"
#include "halfsiphash.h"
#include "integers.h"
#include "text.h"
#include "types.h"
@ -248,11 +250,12 @@ public find_result_t Text$find(CORD str, CORD pat)
return (pos == CORD_NOT_FOUND) ? (find_result_t){.status=FIND_FAILURE} : (find_result_t){.status=FIND_SUCCESS, .index=(int32_t)pos};
}
public CORD Text$replace(CORD text, CORD pat, CORD replacement, int64_t limit)
public CORD Text$replace(CORD text, CORD pat, CORD replacement, Int_t int_limit)
{
if (!text || !pat) return text;
CORD ret = CORD_EMPTY;
size_t pos = 0, pat_len = CORD_len(pat);
int64_t limit = Int$as_i64(int_limit);
for (size_t found; limit != 0 && (found=CORD_str(text, pos, pat)) != CORD_NOT_FOUND; --limit) {
ret = CORD_all(ret, CORD_substr(text, pos, found - pos), replacement);
pos = found + pat_len;
@ -271,7 +274,7 @@ public array_t Text$split(CORD str, CORD split)
for (int64_t i = 0; ; ) {
size_t non_split = u8_strcspn(ustr + i, usplit);
CORD chunk = CORD_substr((CORD)ustr, i, non_split);
Array$insert(&strings, &chunk, 0, sizeof(CORD));
Array$insert(&strings, &chunk, I(0), sizeof(CORD));
i += non_split;
@ -306,7 +309,7 @@ public array_t Text$clusters(CORD text)
char cluster_buf[len+1];
strlcpy(cluster_buf, (char*)pos, len+1);
CORD cluster = CORD_from_char_star(cluster_buf);
Array$insert(&clusters, &cluster, 0, sizeof(CORD));
Array$insert(&clusters, &cluster, I(0), sizeof(CORD));
pos = next;
}
@ -351,7 +354,7 @@ public array_t Text$bytes(CORD text)
return ret;
}
public int64_t Text$num_clusters(CORD text)
public Int_t Text$num_clusters(CORD text)
{
const uint8_t *ustr = (const uint8_t*)CORD_to_const_char_star(text);
int64_t num_clusters = 0;
@ -361,26 +364,26 @@ public int64_t Text$num_clusters(CORD text)
++num_clusters;
pos = next;
}
return num_clusters;
return I(num_clusters);
}
public int64_t Text$num_codepoints(CORD text)
public Int_t Text$num_codepoints(CORD text)
{
uint8_t buf[128] = {0}; size_t norm_len = sizeof(buf);
uint8_t *normalized = _normalize(text, buf, &norm_len);
int64_t num_codepoints = u8_mbsnlen(normalized, norm_len-1);
if (normalized != buf) free(normalized);
return num_codepoints;
return I(num_codepoints);
}
public int64_t Text$num_bytes(CORD text)
public Int_t Text$num_bytes(CORD text)
{
uint8_t norm_buf[128] = {0}; size_t norm_len = sizeof(norm_buf);
uint8_t *normalized = _normalize(text, norm_buf, &norm_len);
--norm_len; // NUL byte
if (!normalized) errx(1, "Unicode normalization error!");
if (normalized != norm_buf) free(normalized);
return norm_len;
return I(norm_len);
}
public array_t Text$character_names(CORD text)

10
builtins/text.h
View File

@ -7,6 +7,8 @@
#include <stdbool.h>
#include <stdint.h>
#include "datatypes.h"
#include "integers.h"
#include "types.h"
#include "where.h"
@ -29,15 +31,15 @@ bool Text$has(CORD str, CORD target, Where_t where);
CORD Text$without(CORD str, CORD target, Where_t where);
CORD Text$trimmed(CORD str, CORD skip, Where_t where);
find_result_t Text$find(CORD str, CORD pat);
CORD Text$replace(CORD text, CORD pat, CORD replacement, int64_t limit);
CORD Text$replace(CORD text, CORD pat, CORD replacement, Int_t limit);
array_t Text$split(CORD str, CORD split);
CORD Text$join(CORD glue, array_t pieces);
array_t Text$clusters(CORD text);
array_t Text$codepoints(CORD text);
array_t Text$bytes(CORD text);
int64_t Text$num_clusters(CORD text);
int64_t Text$num_codepoints(CORD text);
int64_t Text$num_bytes(CORD text);
Int_t Text$num_clusters(CORD text);
Int_t Text$num_codepoints(CORD text);
Int_t Text$num_bytes(CORD text);
array_t Text$character_names(CORD text);
extern const TypeInfo $Text;

1
builtins/tomo.h
View File

@ -5,6 +5,7 @@
#include <gc.h>
#include <gc/cord.h>
#include <gmp.h>
#include <stdbool.h>
#include <stdint.h>
#include <sys/param.h>

201
compile.c
View File

@ -1,11 +1,13 @@
// Compilation logic
#include <ctype.h>
#include <gc/cord.h>
#include <gc.h>
#include <gc/cord.h>
#include <gmp.h>
#include <stdio.h>
#include <uninorm.h>
#include "ast.h"
#include "builtins/integers.h"
#include "builtins/text.h"
#include "compile.h"
#include "enums.h"
@ -140,7 +142,7 @@ CORD compile_type(type_t *t)
case MemoryType: return "void";
case BoolType: return "Bool_t";
case CStringType: return "char*";
case IntType: return Match(t, IntType)->bits == 64 ? "Int_t" : CORD_asprintf("Int%ld_t", Match(t, IntType)->bits);
case IntType: return Match(t, IntType)->bits == 0 ? "Int_t" : CORD_asprintf("Int%ld_t", Match(t, IntType)->bits);
case NumType: return Match(t, NumType)->bits == 64 ? "Num_t" : CORD_asprintf("Num%ld_t", Match(t, NumType)->bits);
case TextType: {
auto text = Match(t, TextType);
@ -548,13 +550,13 @@ CORD compile_statement(env_t *env, ast_t *ast)
if (promote(env, &rhs, rhs_t, Match(lhs_t, ArrayType)->item_type)) {
// arr ++= item
if (update->lhs->tag == Var)
return CORD_all("Array$insert(&", lhs, ", stack(", rhs, "), 0, ", padded_item_size, ");");
return CORD_all("Array$insert(&", lhs, ", stack(", rhs, "), I(0), ", padded_item_size, ");");
else
return CORD_all(lhs, "Array$concat(", lhs, ", Array(", rhs, "), ", padded_item_size, ");");
} else {
// arr ++= [...]
if (update->lhs->tag == Var)
return CORD_all("Array$insert_all(&", lhs, ", ", rhs, ", 0, ", padded_item_size, ");");
return CORD_all("Array$insert_all(&", lhs, ", ", rhs, ", I(0), ", padded_item_size, ");");
else
return CORD_all(lhs, "Array$concat(", lhs, ", ", rhs, ", ", padded_item_size, ");");
}
@ -637,9 +639,7 @@ CORD compile_statement(env_t *env, ast_t *ast)
env->code->funcs = CORD_all(env->code->funcs, code, " ", body, "\n");
if (fndef->cache && fndef->cache->tag == Int) {
int64_t cache_size = Match(fndef->cache, Int)->i;
if (cache_size <= 0)
code_err(fndef->cache, "Cache sizes must be greater than 0");
int64_t cache_size = Int64$from_text(Match(fndef->cache, Int)->str, NULL);
const char *arg_type_name = heap_strf("%s$args", Match(fndef->name, Var)->name);
ast_t *args_def = FakeAST(StructDef, .name=arg_type_name, .fields=fndef->args);
prebind_statement(env, args_def);
@ -653,9 +653,9 @@ CORD compile_statement(env_t *env, ast_t *ast)
all_args = CORD_all(all_args, "$", arg->name, arg->next ? ", " : CORD_EMPTY);
CORD pop_code = CORD_EMPTY;
if (fndef->cache->tag == Int && cache_size < INT64_MAX) {
pop_code = CORD_all("if (Table$length(cache) > ", compile(body_scope, fndef->cache),
") Table$remove(&cache, cache.entries.data + cache.entries.stride*Int$random(0, cache.entries.length-1), table_type);\n");
if (fndef->cache->tag == Int && cache_size > 0) {
pop_code = CORD_all("if (cache.entries.length > ", CORD_asprintf("%ld", cache_size),
") Table$remove(&cache, cache.entries.data + cache.entries.stride*Int$random(I(0), I(cache.entries.length-1)), table_type);\n");
}
CORD arg_typedef = compile_struct_typedef(env, args_def);
@ -851,7 +851,7 @@ CORD compile_statement(env_t *env, ast_t *ast)
switch (iter_t->tag) {
case ArrayType: {
type_t *item_t = Match(iter_t, ArrayType)->item_type;
CORD index = "i";
CORD index = CORD_EMPTY;
CORD value = CORD_EMPTY;
if (for_->vars) {
if (for_->vars->next) {
@ -871,26 +871,30 @@ CORD compile_statement(env_t *env, ast_t *ast)
// `array:from(i)` and `array:to(i)` because these happen inside
// hot path inner loops and can actually meaningfully affect
// performance:
if (for_->iter->tag == MethodCall && streq(Match(for_->iter, MethodCall)->name, "to")
&& value_type(get_type(env, Match(for_->iter, MethodCall)->self))->tag == ArrayType) {
array = Match(for_->iter, MethodCall)->self;
CORD limit = compile_arguments(env, for_->iter, new(arg_t, .type=Type(IntType, .bits=64), .name="last"), Match(for_->iter, MethodCall)->args);
loop = CORD_all(loop, "for (int64_t ", index, " = 1, raw_limit = ", limit,
", limit = raw_limit < 0 ? iterating.length + raw_limit + 1 : raw_limit; ",
index, " <= limit; ++", index, ")");
} else if (for_->iter->tag == MethodCall && streq(Match(for_->iter, MethodCall)->name, "from")
&& value_type(get_type(env, Match(for_->iter, MethodCall)->self))->tag == ArrayType) {
array = Match(for_->iter, MethodCall)->self;
CORD first = compile_arguments(env, for_->iter, new(arg_t, .type=Type(IntType, .bits=64), .name="last"), Match(for_->iter, MethodCall)->args);
loop = CORD_all(loop, "for (int64_t first = ", first, ", ", index, " = MAX(1, first < 1 ? iterating.length + first + 1 : first", "); ",
index, " <= iterating.length; ++", index, ")");
} else {
loop = CORD_all(loop, "for (int64_t ", index, " = 1; ", index, " <= iterating.length; ++", index, ")");
}
// if (for_->iter->tag == MethodCall && streq(Match(for_->iter, MethodCall)->name, "to")
// && value_type(get_type(env, Match(for_->iter, MethodCall)->self))->tag == ArrayType) {
// array = Match(for_->iter, MethodCall)->self;
// CORD limit = compile_arguments(env, for_->iter, new(arg_t, .type=INT_TYPE, .name="last"), Match(for_->iter, MethodCall)->args);
// loop = CORD_all(loop, "for (int64_t ", index, " = 1, raw_limit = ", limit,
// ", limit = raw_limit < 0 ? iterating.length + raw_limit + 1 : raw_limit; ",
// index, " <= limit; ++", index, ")");
// } else if (for_->iter->tag == MethodCall && streq(Match(for_->iter, MethodCall)->name, "from")
// && value_type(get_type(env, Match(for_->iter, MethodCall)->self))->tag == ArrayType) {
// array = Match(for_->iter, MethodCall)->self;
// CORD first = compile_arguments(env, for_->iter, new(arg_t, .type=INT_TYPE, .name="last"), Match(for_->iter, MethodCall)->args);
// loop = CORD_all(loop, "for (int64_t first = ", first, ", ", index, " = MAX(1, first < 1 ? iterating.length + first + 1 : first", "); ",
// index, " <= iterating.length; ++", index, ")");
// } else {
loop = CORD_all(loop, "for (int64_t i = 1; i <= iterating.length; ++i)");
// }
if (index != CORD_EMPTY)
body = CORD_all("Int_t ", index, " = I(i);\n", body);
if (value != CORD_EMPTY) {
loop = CORD_all(loop, "{\n",
compile_declaration(item_t, value),
" = *(", compile_type(item_t), "*)(iterating.data + (",index,"-1)*iterating.stride);\n",
" = *(", compile_type(item_t), "*)(iterating.data + (i-1)*iterating.stride);\n",
body, "\n}");
} else {
loop = CORD_all(loop, "{\n", body, "\n}");
@ -972,14 +976,14 @@ CORD compile_statement(env_t *env, ast_t *ast)
return loop;
}
case IntType: {
CORD value = for_->vars ? compile(env, for_->vars->ast) : "i";
CORD n = compile(env, for_->iter);
if (for_->empty) {
return CORD_all(
"{\n"
"int64_t n = ", n, ";\n"
"int64_t n = Int$as_i64(", n, ");\n"
"if (n > 0) {\n"
"for (int64_t ", value, " = 1; ", value, " <= n; ++", value, ") {\n"
"for (int64_t i = 1; i <= n; ++i) {\n",
for_->vars ? CORD_all("\tInt_t ", compile(env, for_->vars->ast), " = I(i);\n") : CORD_EMPTY,
"\t", body,
"\n}"
"\n} else ", compile_statement(env, for_->empty),
@ -987,7 +991,8 @@ CORD compile_statement(env_t *env, ast_t *ast)
"\n}");
} else {
return CORD_all(
"for (int64_t ", value, " = 1, n = ", compile(env, for_->iter), "; ", value, " <= n; ++", value, ") {\n"
"for (int64_t i = 1, n = Int$as_i64(", compile(env, for_->iter), "); i <= n; ++i) {\n",
for_->vars ? CORD_all("\tInt_t ", compile(env, for_->vars->ast), " = I(i);\n") : CORD_EMPTY,
"\t", body,
"\n}",
stop,
@ -1278,7 +1283,11 @@ CORD compile_math_method(env_t *env, binop_e op, ast_t *lhs, ast_t *rhs, type_t
&& (!required_type || type_eq(required_type, fn->ret))); }))
switch (op) {
case BINOP_MULT: {
if (lhs_t->tag == NumType || lhs_t->tag == IntType) {
if (type_eq(lhs_t, rhs_t)) {
binding_t *b = get_namespace_binding(env, lhs, binop_method_names[op]);
if (binding_works(b, lhs_t, rhs_t, lhs_t))
return CORD_all(b->code, "(", compile(env, lhs), ", ", compile(env, rhs), ")");
} else if (lhs_t->tag == NumType || lhs_t->tag == IntType) {
binding_t *b = get_namespace_binding(env, rhs, "scaled_by");
if (binding_works(b, rhs_t, lhs_t, rhs_t))
return CORD_all(b->code, "(", compile(env, rhs), ", ", compile(env, lhs), ")");
@ -1286,10 +1295,6 @@ CORD compile_math_method(env_t *env, binop_e op, ast_t *lhs, ast_t *rhs, type_t
binding_t *b = get_namespace_binding(env, lhs, "scaled_by");
if (binding_works(b, lhs_t, rhs_t, lhs_t))
return CORD_all(b->code, "(", compile(env, lhs), ", ", compile(env, rhs), ")");
} else if (type_eq(lhs_t, rhs_t)) {
binding_t *b = get_namespace_binding(env, lhs, binop_method_names[op]);
if (binding_works(b, lhs_t, rhs_t, lhs_t))
return CORD_all(b->code, "(", compile(env, lhs), ", ", compile(env, rhs), ")");
}
break;
}
@ -1345,7 +1350,38 @@ CORD compile(env_t *env, ast_t *ast)
return CORD_cat("$", Match(ast, Var)->name);
// code_err(ast, "I don't know of any variable by this name");
}
case Int: return CORD_asprintf("I%ld(%ld)", Match(ast, Int)->bits, Match(ast, Int)->i);
case Int: {
const char *str = Match(ast, Int)->str;
Int_t int_val = Int$from_text(str);
mpz_t i;
mpz_init_set_int(i, int_val);
switch (Match(ast, Int)->bits) {
case 0:
if ((mpz_cmp_si(i, BIGGEST_SMALL_INT) < 0) && (mpz_cmp_si(i, -BIGGEST_SMALL_INT) > 0)) {
return CORD_asprintf("I(%s)", str);
} else {
return CORD_asprintf("Int$from_text(\"%s\")", str);
}
case 64:
if ((mpz_cmp_si(i, INT64_MAX) < 0) && (mpz_cmp_si(i, INT64_MIN) > 0))
return CORD_asprintf("I64(%s)", str);
code_err(ast, "This value cannot fit in a 64-bit integer");
case 32:
if ((mpz_cmp_si(i, INT32_MAX) < 0) && (mpz_cmp_si(i, INT32_MIN) > 0))
return CORD_asprintf("I32(%s)", str);
code_err(ast, "This value cannot fit in a 32-bit integer");
case 16:
if ((mpz_cmp_si(i, INT16_MAX) < 0) && (mpz_cmp_si(i, INT16_MIN) > 0))
return CORD_asprintf("I16(%s)", str);
code_err(ast, "This value cannot fit in a 16-bit integer");
case 8:
if ((mpz_cmp_si(i, INT8_MAX) < 0) && (mpz_cmp_si(i, INT8_MIN) > 0))
return CORD_asprintf("I8(%s)", str);
code_err(ast, "This value cannot fit in a 8-bit integer");
default: code_err(ast, "Not a valid integer bit width");
}
}
case Num: {
return CORD_asprintf(Match(ast, Num)->bits == 64 ? "N64(%.9g)" : "N32(%.9g)", Match(ast, Num)->n);
}
@ -1360,19 +1396,19 @@ CORD compile(env_t *env, ast_t *ast)
case ArrayType: {
if (t->tag == PointerType) {
CORD arr = compile_to_pointer_depth(env, expr, 1, false);
return CORD_all("I64((", arr, ")->length)");
return CORD_all("I((", arr, ")->length)");
} else {
CORD arr = compile_to_pointer_depth(env, expr, 0, false);
return CORD_all("I64((", arr, ").length)");
return CORD_all("I((", arr, ").length)");
}
}
case TableType: {
if (t->tag == PointerType) {
CORD table = compile_to_pointer_depth(env, expr, 1, false);
return CORD_all("I64((", table, ")->entries.length)");
return CORD_all("I((", table, ")->entries.length)");
} else {
CORD table = compile_to_pointer_depth(env, expr, 0, false);
return CORD_all("I64((", table, ").entries.length)");
return CORD_all("I((", table, ").entries.length)");
}
}
default: {
@ -1382,8 +1418,16 @@ CORD compile(env_t *env, ast_t *ast)
break;
}
case Not: {
type_t *t = get_type(env, ast);
ast_t *value = Match(ast, Not)->value;
type_t *t = get_type(env, ast);
binding_t *b = get_namespace_binding(env, value, "negated");
if (b && b->type->tag == FunctionType) {
auto fn = Match(b->type, FunctionType);
if (fn->args && can_promote(t, get_arg_type(env, fn->args)))
return CORD_all(b->code, "(", compile_arguments(env, ast, fn->args, new(arg_ast_t, .value=value)), ")");
}
if (t->tag == BoolType)
return CORD_all("!(", compile(env, value), ")");
else if (t->tag == IntType)
@ -1393,21 +1437,11 @@ CORD compile(env_t *env, ast_t *ast)
else if (t->tag == TextType)
return CORD_all("!(", compile(env, value), ")");
binding_t *b = get_namespace_binding(env, value, "negated");
if (b && b->type->tag == FunctionType) {
auto fn = Match(b->type, FunctionType);
if (fn->args && can_promote(t, get_arg_type(env, fn->args)))
return CORD_all(b->code, "(", compile_arguments(env, ast, fn->args, new(arg_ast_t, .value=value)), ")");
}
code_err(ast, "I don't know how to negate values of type %T", t);
}
case Negative: {
ast_t *value = Match(ast, Negative)->value;
type_t *t = get_type(env, value);
if (t->tag == IntType || t->tag == NumType)
return CORD_all("-(", compile(env, value), ")");
binding_t *b = get_namespace_binding(env, value, "negative");
if (b && b->type->tag == FunctionType) {
auto fn = Match(b->type, FunctionType);
@ -1415,6 +1449,9 @@ CORD compile(env_t *env, ast_t *ast)
return CORD_all(b->code, "(", compile_arguments(env, ast, fn->args, new(arg_ast_t, .value=value)), ")");
}
if (t->tag == IntType || t->tag == NumType)
return CORD_all("-(", compile(env, value), ")");
code_err(ast, "I don't know how to get the negative value of type %T", t);
}
@ -1499,7 +1536,11 @@ CORD compile(env_t *env, ast_t *ast)
}
case BINOP_EQ: {
switch (operand_t->tag) {
case BoolType: case IntType: case NumType: case PointerType: case FunctionType:
case IntType:
if (Match(operand_t, IntType)->bits == 0)
return CORD_all("Int$equal_value(", lhs, ", ", rhs, ")");
return CORD_all("(", lhs, " == ", rhs, ")");
case BoolType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, " == ", rhs, ")");
default:
return CORD_asprintf("generic_equal(stack(%r), stack(%r), %r)", lhs, rhs, compile_type_info(env, operand_t));
@ -1507,7 +1548,11 @@ CORD compile(env_t *env, ast_t *ast)
}
case BINOP_NE: {
switch (operand_t->tag) {
case BoolType: case IntType: case NumType: case PointerType: case FunctionType:
case IntType:
if (Match(operand_t, IntType)->bits == 0)
return CORD_all("!Int$equal_value(", lhs, ", ", rhs, ")");
return CORD_all("(", lhs, " != ", rhs, ")");
case BoolType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, " != ", rhs, ")");
default:
return CORD_asprintf("!generic_equal(stack(%r), stack(%r), %r)", lhs, rhs, compile_type_info(env, operand_t));
@ -1515,7 +1560,11 @@ CORD compile(env_t *env, ast_t *ast)
}
case BINOP_LT: {
switch (operand_t->tag) {
case BoolType: case IntType: case NumType: case PointerType: case FunctionType:
case IntType:
if (Match(operand_t, IntType)->bits == 0)
return CORD_all("(Int$compare_value(", lhs, ", ", rhs, ") < 0)");
return CORD_all("(", lhs, " != ", rhs, ")");
case BoolType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, " < ", rhs, ")");
default:
return CORD_asprintf("(generic_compare(stack(%r), stack(%r), %r) < 0)", lhs, rhs, compile_type_info(env, operand_t));
@ -1523,7 +1572,11 @@ CORD compile(env_t *env, ast_t *ast)
}
case BINOP_LE: {
switch (operand_t->tag) {
case BoolType: case IntType: case NumType: case PointerType: case FunctionType:
case IntType:
if (Match(operand_t, IntType)->bits == 0)
return CORD_all("(Int$compare_value(", lhs, ", ", rhs, ") <= 0)");
return CORD_all("(", lhs, " != ", rhs, ")");
case BoolType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, " <= ", rhs, ")");
default:
return CORD_asprintf("(generic_compare(stack(%r), stack(%r), %r) <= 0)", lhs, rhs, compile_type_info(env, operand_t));
@ -1531,7 +1584,11 @@ CORD compile(env_t *env, ast_t *ast)
}
case BINOP_GT: {
switch (operand_t->tag) {
case BoolType: case IntType: case NumType: case PointerType: case FunctionType:
case IntType:
if (Match(operand_t, IntType)->bits == 0)
return CORD_all("(Int$compare_value(", lhs, ", ", rhs, ") > 0)");
return CORD_all("(", lhs, " != ", rhs, ")");
case BoolType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, " > ", rhs, ")");
default:
return CORD_asprintf("(generic_compare(stack(%r), stack(%r), %r) > 0)", lhs, rhs, compile_type_info(env, operand_t));
@ -1539,7 +1596,11 @@ CORD compile(env_t *env, ast_t *ast)
}
case BINOP_GE: {
switch (operand_t->tag) {
case BoolType: case IntType: case NumType: case PointerType: case FunctionType:
case IntType:
if (Match(operand_t, IntType)->bits == 0)
return CORD_all("(Int$compare_value(", lhs, ", ", rhs, ") >= 0)");
return CORD_all("(", lhs, " != ", rhs, ")");
case BoolType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, " >= ", rhs, ")");
default:
return CORD_asprintf("(generic_compare(stack(%r), stack(%r), %r) >= 0)", lhs, rhs, compile_type_info(env, operand_t));
@ -1999,19 +2060,19 @@ CORD compile(env_t *env, ast_t *ast)
if (streq(call->name, "insert")) {
CORD self = compile_to_pointer_depth(env, call->self, 1, false);
arg_t *arg_spec = new(arg_t, .name="item", .type=item_t,
.next=new(arg_t, .name="at", .type=Type(IntType, .bits=64), .default_val=FakeAST(Int, .i=0, .bits=64)));
.next=new(arg_t, .name="at", .type=INT_TYPE, .default_val=FakeAST(Int, .str="0", .bits=0)));
return CORD_all("Array$insert_value(", self, ", ", compile_arguments(env, ast, arg_spec, call->args), ", ",
padded_item_size, ")");
} else if (streq(call->name, "insert_all")) {
CORD self = compile_to_pointer_depth(env, call->self, 1, false);
arg_t *arg_spec = new(arg_t, .name="items", .type=self_value_t,
.next=new(arg_t, .name="at", .type=Type(IntType, .bits=64), .default_val=FakeAST(Int, .i=0, .bits=64)));
.next=new(arg_t, .name="at", .type=INT_TYPE, .default_val=FakeAST(Int, .str="0", .bits=0)));
return CORD_all("Array$insert_all(", self, ", ", compile_arguments(env, ast, arg_spec, call->args), ", ",
padded_item_size, ")");
} else if (streq(call->name, "remove")) {
CORD self = compile_to_pointer_depth(env, call->self, 1, false);
arg_t *arg_spec = new(arg_t, .name="index", .type=Type(IntType, .bits=64), .default_val=FakeAST(Int, .i=-1, .bits=64),
.next=new(arg_t, .name="count", .type=Type(IntType, .bits=64), .default_val=FakeAST(Int, .i=1, .bits=64)));
arg_t *arg_spec = new(arg_t, .name="index", .type=INT_TYPE, .default_val=FakeAST(Int, .str="-1", .bits=0),
.next=new(arg_t, .name="count", .type=INT_TYPE, .default_val=FakeAST(Int, .str="1", .bits=0)));
return CORD_all("Array$remove(", self, ", ", compile_arguments(env, ast, arg_spec, call->args), ", ",
padded_item_size, ")");
} else if (streq(call->name, "random")) {
@ -2020,7 +2081,7 @@ CORD compile(env_t *env, ast_t *ast)
return CORD_all("Array$random_value(", self, ", ", compile_type(item_t), ")");
} else if (streq(call->name, "sample")) {
CORD self = compile_to_pointer_depth(env, call->self, 0, false);
arg_t *arg_spec = new(arg_t, .name="count", .type=Type(IntType, .bits=64),
arg_t *arg_spec = new(arg_t, .name="count", .type=INT_TYPE,
.next=new(arg_t, .name="weights", .type=Type(ArrayType, .item_type=Type(NumType, .bits=64)),
.default_val=FakeAST(Array, .item_type=new(type_ast_t, .tag=VarTypeAST, .__data.VarTypeAST.name="Num"))));
return CORD_all("Array$sample(", self, ", ", compile_arguments(env, ast, arg_spec, call->args), ", ",
@ -2079,15 +2140,15 @@ CORD compile(env_t *env, ast_t *ast)
return CORD_all("Array$clear(", self, ")");
} else if (streq(call->name, "from")) {
CORD self = compile_to_pointer_depth(env, call->self, 0, false);
arg_t *arg_spec = new(arg_t, .name="first", .type=Type(IntType, .bits=64));
arg_t *arg_spec = new(arg_t, .name="first", .type=INT_TYPE);
return CORD_all("Array$from(", self, ", ", compile_arguments(env, ast, arg_spec, call->args), ")");
} else if (streq(call->name, "to")) {
CORD self = compile_to_pointer_depth(env, call->self, 0, false);
arg_t *arg_spec = new(arg_t, .name="last", .type=Type(IntType, .bits=64));
arg_t *arg_spec = new(arg_t, .name="last", .type=INT_TYPE);
return CORD_all("Array$to(", self, ", ", compile_arguments(env, ast, arg_spec, call->args), ")");
} else if (streq(call->name, "by")) {
CORD self = compile_to_pointer_depth(env, call->self, 0, false);
arg_t *arg_spec = new(arg_t, .name="stride", .type=Type(IntType, .bits=64));
arg_t *arg_spec = new(arg_t, .name="stride", .type=INT_TYPE);
return CORD_all("Array$by(", self, ", ", compile_arguments(env, ast, arg_spec, call->args), ", ", padded_item_size, ")");
} else if (streq(call->name, "reversed")) {
CORD self = compile_to_pointer_depth(env, call->self, 0, false);
@ -2227,7 +2288,7 @@ CORD compile(env_t *env, ast_t *ast)
if (!(table->value_type->tag == IntType || table->value_type->tag == NumType))
code_err(ast, "bump() is only supported for tables with numeric value types, not %T", self_value_t);
ast_t *one = table->value_type->tag == IntType
? FakeAST(Int, .i=1, .bits=Match(table->value_type, IntType)->bits)
? FakeAST(Int, .str="1", .bits=Match(table->value_type, IntType)->bits)
: FakeAST(Num, .n=1, .bits=Match(table->value_type, NumType)->bits);
arg_t *arg_spec = new(arg_t, .name="key", .type=table->key_type,
.next=new(arg_t, .name="amount", .type=table->value_type, .default_val=one));
@ -2611,7 +2672,7 @@ CORD compile_cli_arg_call(env_t *env, CORD fn_name, type_t *fn_type)
for (arg_t *arg = fn_info->args; arg; arg = arg->next) {
usage = CORD_cat(usage, " ");
type_t *t = get_arg_type(main_env, arg);
CORD flag = Text$replace(arg->name, "_", "-", INT64_MAX);
CORD flag = Text$replace(arg->name, "_", "-", I(-1));
if (arg->default_val) {
if (t->tag == BoolType)
usage = CORD_all(usage, "[--", flag, "]");
@ -2649,7 +2710,7 @@ CORD compile_cli_arg_call(env_t *env, CORD fn_name, type_t *fn_type)
"if (strncmp(argv[i], \"--\", 2) != 0) {\n++i;\ncontinue;\n}\n");
for (arg_t *arg = fn_info->args; arg; arg = arg->next) {
type_t *t = get_arg_type(main_env, arg);
CORD flag = Text$replace(arg->name, "_", "-", INT64_MAX);
CORD flag = Text$replace(arg->name, "_", "-", I(-1));
switch (t->tag) {
case BoolType: {
code = CORD_all(code, "else if (pop_flag(argv, &i, \"", flag, "\", &flag)) {\n"

41
environment.c
View File

@ -66,7 +66,7 @@ env_t *new_compilation_unit(CORD *libname)
StructType, .name="Range", .env=range_env,
.fields=new(arg_t, .name="first", .type=INT_TYPE,
.next=new(arg_t, .name="last", .type=INT_TYPE,
.next=new(arg_t, .name="step", .type=INT_TYPE, .default_val=FakeAST(Int, .i=1, .bits=64)))));
.next=new(arg_t, .name="step", .type=INT_TYPE, .default_val=FakeAST(Int, .str="1")))));
}
{
@ -86,17 +86,40 @@ env_t *new_compilation_unit(CORD *libname)
{"Bool", Type(BoolType), "Bool_t", "$Bool", TypedArray(ns_entry_t,
{"from_text", "Bool$from_text", "func(text:Text, success=!&Bool)->Bool"},
)},
{"Int", Type(IntType, .bits=64), "Int_t", "$Int", TypedArray(ns_entry_t,
{"Int", Type(IntType, .bits=0), "Int_t", "$Int", TypedArray(ns_entry_t,
{"format", "Int$format", "func(i:Int, digits=0)->Text"},
{"hex", "Int$hex", "func(i:Int, digits=0, uppercase=yes, prefix=yes)->Text"},
{"octal", "Int$octal", "func(i:Int, digits=0, prefix=yes)->Text"},
{"random", "Int$random", "func(min=-0x8000000000000000, max=0x7FFFFFFFFFFFFFFF)->Int"},
{"random", "Int$random", "func(min:Int, max:Int)->Int"},
{"from_text", "Int$from_text", "func(text:Text, the_rest=!&Text)->Int"},
{"bits", "Int$bits", "func(x:Int)->[Bool]"},
{"abs", "labs", "func(i:Int)->Int"},
{"min", "Int$min", "Int"},
{"max", "Int$max", "Int"},
{"to", "Int$to", "func(from:Int,to:Int)->Range"},
{"plus", "Int$plus", "func(x:Int,y:Int)->Int"},
{"minus", "Int$minus", "func(x:Int,y:Int)->Int"},
{"times", "Int$times", "func(x:Int,y:Int)->Int"},
{"divided_by", "Int$divided_by", "func(x:Int,y:Int)->Int"},
{"modulo", "Int$modulo", "func(x:Int,y:Int)->Int"},
{"modulo1", "Int$modulo1", "func(x:Int,y:Int)->Int"},
{"left_shifted", "Int$left_shifted", "func(x:Int,y:Int)->Int"},
{"right_shifted", "Int$right_shifted", "func(x:Int,y:Int)->Int"},
{"bit_and", "Int$bit_and", "func(x:Int,y:Int)->Int"},
{"bit_or", "Int$bit_or", "func(x:Int,y:Int)->Int"},
{"bit_xor", "Int$bit_xor", "func(x:Int,y:Int)->Int"},
{"negative", "Int$negative", "func(x:Int)->Int"},
{"negated", "Int$negated", "func(x:Int)->Int"},
{"abs", "Int$abs", "func(x:Int)->Int"},
)},
{"Int64", Type(IntType, .bits=64), "Int64_t", "$Int64", TypedArray(ns_entry_t,
{"format", "Int64$format", "func(i:Int64, digits=0)->Text"},
{"hex", "Int64$hex", "func(i:Int64, digits=0, uppercase=yes, prefix=yes)->Text"},
{"octal", "Int64$octal", "func(i:Int64, digits=0, prefix=yes)->Text"},
{"random", "Int64$random", "func(min=-0x8000000000000000, max=0x7FFFFFFFFFFFFFFF)->Int64"},
{"from_text", "Int64$from_text", "func(text:Text, the_rest=!&Text)->Int64"},
{"bits", "Int64$bits", "func(x:Int64)->[Bool]"},
{"abs", "labs", "func(i:Int64)->Int64"},
{"min", "Int64$min", "Int64"},
{"max", "Int64$max", "Int64"},
{"to", "Int64$to", "func(from:Int64,to:Int64)->Range"},
)},
{"Int32", Type(IntType, .bits=32), "Int32_t", "$Int32", TypedArray(ns_entry_t,
{"format", "Int32$format", "func(i:Int32, digits=0)->Text"},
@ -213,7 +236,7 @@ env_t *new_compilation_unit(CORD *libname)
{"num_clusters", "Text$num_clusters", "func(text:Text)->Int"},
{"num_codepoints", "Text$num_codepoints", "func(text:Text)->Int"},
{"quoted", "Text$quoted", "func(text:Text, color=no)->Text"},
{"replace", "Text$replace", "func(text:Text, pattern:Text, replacement:Text, limit=Int.max)->Text"},
{"replace", "Text$replace", "func(text:Text, pattern:Text, replacement:Text, limit=-1)->Text"},
{"split", "Text$split", "func(text:Text, split:Text)->[Text]"},
{"title", "Text$title", "func(text:Text)->Text"},
{"title", "Text$title", "func(text:Text)->Text"},
@ -340,7 +363,7 @@ env_t *for_scope(env_t *env, ast_t *ast)
if (num_vars == 1) {
set_binding(scope, vars[0], new(binding_t, .type=item_t, .code=CORD_cat("$", vars[0])));
} else if (num_vars == 2) {
set_binding(scope, vars[0], new(binding_t, .type=Type(IntType, .bits=64), .code=CORD_cat("$", vars[0])));
set_binding(scope, vars[0], new(binding_t, .type=INT_TYPE, .code=CORD_cat("$", vars[0])));
set_binding(scope, vars[1], new(binding_t, .type=item_t, .code=CORD_cat("$", vars[1])));
}
return scope;
@ -379,7 +402,7 @@ env_t *for_scope(env_t *env, ast_t *ast)
if (for_->vars->next)
code_err(for_->vars->next->ast, "This is too many variables for this loop");
const char *var = Match(for_->vars->ast, Var)->name;
set_binding(scope, var, new(binding_t, .type=Type(IntType, .bits=64), .code=CORD_cat("$", var)));
set_binding(scope, var, new(binding_t, .type=INT_TYPE, .code=CORD_cat("$", var)));
}
return scope;
}

57
parse.c
View File

@ -1,6 +1,7 @@
// Recursive descent parser for parsing code
#include <ctype.h>
#include <gc.h>
#include <gmp.h>
#include <libgen.h>
#include <linux/limits.h>
#include <setjmp.h>
@ -12,6 +13,7 @@
#include <signal.h>
#include "ast.h"
#include "builtins/integers.h"
#include "builtins/table.h"
#include "builtins/util.h"
@ -439,59 +441,34 @@ PARSER(parse_parens) {
PARSER(parse_int) {
const char *start = pos;
bool negative = match(&pos, "-");
(void)match(&pos, "-");
if (!isdigit(*pos)) return false;
int64_t i = 0;
if (match(&pos, "0x")) { // Hex
size_t span = strspn(pos, "0123456789abcdefABCDEF_");
char *buf = GC_MALLOC_ATOMIC(span+1);
memset(buf, 0, span+1);
for (char *src = (char*)pos, *dest = buf; src < pos+span; ++src) {
if (*src != '_') *(dest++) = *src;
}
i = strtol(buf, NULL, 16);
pos += span;
pos += strspn(pos, "0123456789abcdefABCDEF_");
} else if (match(&pos, "0b")) { // Binary
size_t span = strspn(pos, "01_");
char *buf = GC_MALLOC_ATOMIC(span+1);
memset(buf, 0, span+1);
for (char *src = (char*)pos, *dest = buf; src < pos+span; ++src) {
if (*src != '_') *(dest++) = *src;
}
i = strtol(buf, NULL, 2);
pos += span;
pos += strspn(pos, "01_");
} else if (match(&pos, "0o")) { // Octal
size_t span = strspn(pos, "01234567_");
char *buf = GC_MALLOC_ATOMIC(span+1);
memset(buf, 0, span+1);
for (char *src = (char*)pos, *dest = buf; src < pos+span; ++src) {
if (*src != '_') *(dest++) = *src;
}
i = strtol(buf, NULL, 8);
pos += span;
pos += strspn(pos, "01234567_");
} else { // Decimal
size_t span = strspn(pos, "0123456789_");
char *buf = GC_MALLOC_ATOMIC(span+1);
memset(buf, 0, span+1);
for (char *src = (char*)pos, *dest = buf; src < pos+span; ++src) {
if (*src != '_') *(dest++) = *src;
}
i = strtol(buf, NULL, 10);
pos += span;
pos += strspn(pos, "0123456789_");
}
char *str = GC_MALLOC_ATOMIC((size_t)(pos - start) + 1);
memset(str, 0, (size_t)(pos - start) + 1);
for (char *src = (char*)start, *dest = str; src < pos; ++src) {
if (*src != '_') *(dest++) = *src;
}
if (match(&pos, "e") || match(&pos, "f")) // floating point literal
return NULL;
if (negative) i *= -1;
if (match(&pos, "%")) {
double d = (double)i / 100.;
return NewAST(ctx->file, start, pos, Num, .n=d, .bits=64);
}
match(&pos, "_");
int64_t bits = 64;
int64_t bits = 0;
if (match(&pos, "i64")) bits = 64;
else if (match(&pos, "i32")) bits = 32;
else if (match(&pos, "i16")) bits = 16;
@ -499,7 +476,7 @@ PARSER(parse_int) {
// else if (match(&pos, ".") || match(&pos, "e")) return NULL; // looks like a float
return NewAST(ctx->file, start, pos, Int, .i=i, .bits=bits);
return NewAST(ctx->file, start, pos, Int, .str=str, .bits=bits);
}
type_ast_t *parse_table_type(parse_ctx_t *ctx, const char *pos) {
@ -1908,7 +1885,9 @@ ast_t *parse_enum_def(parse_ctx_t *ctx, const char *pos) {
spaces(&pos);
if (match(&pos, "=")) {
ast_t *val = expect(ctx, tag_start, &pos, parse_int, "I expected an integer literal after this '='");
next_value = Match(val, Int)->i;
Int_t i = Int$from_text(Match(val, Int)->str);
// TODO check for overflow
next_value = (i.small >> 2);
}
// Check for duplicate values:
@ -2051,7 +2030,7 @@ PARSER(parse_func_def) {
if (match_word(&pos, "inline")) {
is_inline = true;
} else if (match_word(&pos, "cached")) {
if (!cache_ast) cache_ast = NewAST(ctx->file, pos, pos, Int, .i=INT64_MAX, .bits=64);
if (!cache_ast) cache_ast = NewAST(ctx->file, pos, pos, Int, .str="-1", .bits=0);
} else if (match_word(&pos, "cache_size")) {
whitespace(&pos);
if (!match(&pos, "="))

11
repl.c
View File

@ -344,10 +344,11 @@ void eval(env_t *env, ast_t *ast, void *dest)
case Int: {
if (!dest) return;
switch (Match(ast, Int)->bits) {
case 0: case 64: *(int64_t*)dest = Match(ast, Int)->i; break;
case 32: *(int32_t*)dest = Match(ast, Int)->i; break;
case 16: *(int16_t*)dest = Match(ast, Int)->i; break;
case 8: *(int8_t*)dest = Match(ast, Int)->i; break;
case 0: *(Int_t*)dest = Int$from_text(Match(ast, Int)->str); break;
case 64: *(int64_t*)dest = Int64$from_text(Match(ast, Int)->str, NULL); break;
case 32: *(int32_t*)dest = Int32$from_text(Match(ast, Int)->str, NULL); break;
case 16: *(int16_t*)dest = Int16$from_text(Match(ast, Int)->str, NULL); break;
case 8: *(int8_t*)dest = Int8$from_text(Match(ast, Int)->str, NULL); break;
default: errx(1, "Invalid int bits: %ld", Match(ast, Int)->bits);
}
break;
@ -484,7 +485,7 @@ void eval(env_t *env, ast_t *ast, void *dest)
char item_buf[item_size] = {};
for (ast_list_t *item = Match(ast, Array)->items; item; item = item->next) {
eval(env, item->ast, item_buf);
Array$insert(&arr, item_buf, 0, padded_type_size(Match(t, ArrayType)->item_type));
Array$insert(&arr, item_buf, I(0), padded_type_size(Match(t, ArrayType)->item_type));
}
memcpy(dest, &arr, sizeof(array_t));
break;

4
test/arrays.tm
View File

@ -101,7 +101,7 @@ func main():
>> ["A", "B", "C"]:sample(10, [1.0, 0.5, 0.0])
do:
>> heap := [Int.random(max=50) for _ in 10]
>> heap := [Int.random(1, 50) for _ in 10]
>> heap:heapify()
>> heap
sorted := [:Int]
@ -110,7 +110,7 @@ func main():
>> sorted == sorted:sorted()
= yes
for _ in 10:
heap:heap_push(Int.random(max=50))
heap:heap_push(Int.random(1, 50))
>> heap
sorted = [:Int]
while #heap > 0:

2
tomo.c
View File

@ -116,7 +116,7 @@ int main(int argc, char *argv[])
ldflags = CORD_all("-Wl,-rpath='$ORIGIN',-rpath='", home, "/.local/lib/tomo' -L. -L'", home, "/.local/lib/tomo'");
ldlibs = "-lgc -lcord -lm -ltomo";
ldlibs = "-lgc -lgmp -lcord -lm -ltomo";
cc = ENV_CORD("CC");
if (!cc) cc = "cc";

3
typecheck.c
View File

@ -1,6 +1,7 @@
// Logic for getting a type from an AST node
#include <ctype.h>
#include <gc.h>
#include <gmp.h>
#include <signal.h>
#include <stdarg.h>
#include <stdlib.h>
@ -828,7 +829,7 @@ type_t *get_type(env_t *env, ast_t *ast)
return Type(AbortType);
}
case Pass: case Defer: return Type(VoidType);
case Length: return Type(IntType, .bits=64);
case Length: return INT_TYPE;
case Negative: {
ast_t *value = Match(ast, Negative)->value;
type_t *t = get_type(env, value);

32
types.c
View File

@ -19,7 +19,7 @@ CORD type_to_cord(type_t *t) {
case BoolType: return "Bool";
case CStringType: return "CString";
case TextType: return Match(t, TextType)->lang ? Match(t, TextType)->lang : "Text";
case IntType: return Match(t, IntType)->bits == 64 ? "Int" : CORD_asprintf("Int%ld", Match(t, IntType)->bits);
case IntType: return Match(t, IntType)->bits == 0 ? "Int" : CORD_asprintf("Int%ld", Match(t, IntType)->bits);
case NumType: return Match(t, NumType)->bits == 64 ? "Num" : CORD_asprintf("Num%ld", Match(t, NumType)->bits);
case ArrayType: {
auto array = Match(t, ArrayType);
@ -143,11 +143,7 @@ type_t *type_or_type(type_t *a, type_t *b)
switch (compare_precision(a, b)) {
case NUM_PRECISION_EQUAL: case NUM_PRECISION_MORE: return a;
case NUM_PRECISION_LESS: return b;
case NUM_PRECISION_INCOMPARABLE: {
if (a->tag == IntType && b->tag == IntType && Match(a, IntType)->bits < 64)
return Type(IntType, .bits=Match(a, IntType)->bits * 2);
return NULL;
}
default: return NULL;
}
return NULL;
}
@ -160,6 +156,7 @@ static inline double type_min_magnitude(type_t *t)
case BoolType: return (double)false;
case IntType: {
switch (Match(t, IntType)->bits) {
case 0: return -1./0.;
case 8: return (double)INT8_MIN;
case 16: return (double)INT16_MIN;
case 32: return (double)INT32_MIN;
@ -178,6 +175,7 @@ static inline double type_max_magnitude(type_t *t)
case BoolType: return (double)true;
case IntType: {
switch (Match(t, IntType)->bits) {
case 0: return 1./0.;
case 8: return (double)INT8_MAX;
case 16: return (double)INT16_MAX;
case 32: return (double)INT32_MAX;
@ -448,7 +446,16 @@ size_t type_size(type_t *t)
case MemoryType: errx(1, "Memory has undefined type size");
case BoolType: return sizeof(bool);
case CStringType: return sizeof(char*);
case IntType: return Match(t, IntType)->bits/8;
case IntType: {
switch (Match(t, IntType)->bits) {
case 0: return sizeof(Int_t);
case 64: return sizeof(int64_t);
case 32: return sizeof(int32_t);
case 16: return sizeof(int16_t);
case 8: return sizeof(int8_t);
default: return 0;
}
}
case NumType: return Match(t, NumType)->bits/8;
case TextType: return sizeof(CORD);
case ArrayType: return sizeof(array_t);
@ -502,7 +509,16 @@ size_t type_align(type_t *t)
case MemoryType: errx(1, "Memory has undefined type alignment");
case BoolType: return __alignof__(bool);
case CStringType: return __alignof__(char*);
case IntType: return Match(t, IntType)->bits/8;
case IntType: {
switch (Match(t, IntType)->bits) {
case 0: return __alignof__(Int_t);
case 64: return __alignof__(int64_t);
case 32: return __alignof__(int32_t);
case 16: return __alignof__(int16_t);
case 8: return __alignof__(int8_t);
default: return 0;
}
}
case NumType: return Match(t, NumType)->bits/8;
case TextType: return __alignof__(CORD);
case SetType: return __alignof__(table_t);

2
types.h
View File

@ -121,7 +121,7 @@ struct type_s {
};
#define Type(typetag, ...) new(type_t, .tag=typetag, .__data.typetag={__VA_ARGS__})
#define INT_TYPE Type(IntType, .bits=64)
#define INT_TYPE Type(IntType, .bits=0)
#define NUM_TYPE Type(NumType, .bits=64)
int printf_pointer_size(const struct printf_info *info, size_t n, int argtypes[n], int size[n]);