aboutsummaryrefslogtreecommitdiff
path: root/src_c
diff options
context:
space:
mode:
Diffstat (limited to 'src_c')
-rw-r--r--src_c/apply.c140
-rw-r--r--src_c/apply.h10
-rw-r--r--src_c/arch.h63
-rw-r--r--src_c/arch/avr8.c63
-rw-r--r--src_c/arch/avr8.h30
-rw-r--r--src_c/arch/posix.c54
-rw-r--r--src_c/arch/posix.h30
-rw-r--r--src_c/buff.c61
-rw-r--r--src_c/buff.h23
-rw-r--r--src_c/builtin.c65
-rw-r--r--src_c/builtin.h24
-rw-r--r--src_c/cell.c50
-rw-r--r--src_c/cell.h215
-rw-r--r--src_c/ctx.c231
-rw-r--r--src_c/ctx.h16
-rw-r--r--src_c/env.c86
-rw-r--r--src_c/env.h30
-rw-r--r--src_c/eval.c92
-rw-r--r--src_c/eval.h9
-rw-r--r--src_c/function.c582
-rw-r--r--src_c/function.h54
-rw-r--r--src_c/main.c55
-rw-r--r--src_c/mem.c478
-rw-r--r--src_c/mem.h189
-rw-r--r--src_c/read.c428
-rw-r--r--src_c/read.h10
-rw-r--r--src_c/repl.c104
-rw-r--r--src_c/repl.h9
-rw-r--r--src_c/status.h25
-rw-r--r--src_c/stream.c108
-rw-r--r--src_c/stream.h46
-rw-r--r--src_c/syntax.c192
-rw-r--r--src_c/syntax.h17
-rw-r--r--src_c/write.c174
-rw-r--r--src_c/write.h10
35 files changed, 3773 insertions, 0 deletions
diff --git a/src_c/apply.c b/src_c/apply.c
new file mode 100644
index 0000000..4dd8684
--- /dev/null
+++ b/src_c/apply.c
@@ -0,0 +1,140 @@
+#include "apply.h"
+#include "ctx.h"
+#include "eval.h"
+#include "function.h"
+#include "syntax.h"
+#include "write.h"
+
+
+static lsp_status_t create_ctx(lsp_env_t *e, lsp_addr_t parent_ctx,
+ lsp_addr_t arg_names, lsp_addr_t arg_values,
+ lsp_addr_t *result) {
+ lsp_status_t status = lsp_ctx_copy(e->m, parent_ctx, result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ while (arg_names != e->m->nil) {
+ if (lsp_mem_is_symbol(e->m, arg_names)) {
+ status = lsp_ctx_add(e->m, *result, arg_names, arg_values);
+ arg_values = e->m->nil;
+ break;
+ }
+
+ if (arg_values == e->m->nil) {
+ status = LSP_ERR_ARG_COUNT;
+ break;
+ }
+
+ lsp_addr_t arg_name = lsp_mem_get_pair_first(e->m, arg_names);
+ lsp_addr_t arg_value = lsp_mem_get_pair_first(e->m, arg_values);
+
+ if (!lsp_mem_is_symbol(e->m, arg_name)) {
+ status = LSP_ERR_ARG_TYPE;
+ break;
+ }
+
+ status = lsp_ctx_add(e->m, *result, arg_name, arg_value);
+ if (status != LSP_SUCCESS)
+ break;
+
+ arg_names = lsp_mem_get_pair_second(e->m, arg_names);
+ arg_values = lsp_mem_get_pair_second(e->m, arg_values);
+ }
+
+ if (status == LSP_SUCCESS && arg_values != e->m->nil)
+ status = LSP_ERR_ARG_COUNT;
+
+ if (status != LSP_SUCCESS)
+ lsp_mem_dec_ref(e->m, *result);
+
+ return status;
+}
+
+
+static lsp_status_t apply_builtin_function(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t callable,
+ lsp_addr_t args) {
+ lsp_uint16_t index = lsp_mem_get_builtin_index(e->m, callable);
+ lsp_builtin_cb_t cb = lsp_functions[index].cb;
+ return cb(e, ctx, args);
+}
+
+
+static lsp_status_t apply_builtin_syntax(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t callable, lsp_addr_t args) {
+ lsp_uint16_t index = lsp_mem_get_builtin_index(e->m, callable);
+ lsp_builtin_cb_t cb = lsp_syntaxes[index].cb;
+ return cb(e, ctx, args);
+}
+
+
+static lsp_status_t apply_function(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t callable, lsp_addr_t args) {
+ lsp_addr_t parent_ctx = lsp_mem_get_function_parent_ctx(e->m, callable);
+ lsp_addr_t arg_names = lsp_mem_get_function_args(e->m, callable);
+ lsp_addr_t body = lsp_mem_get_function_body(e->m, callable);
+
+ lsp_addr_t fn_ctx;
+ lsp_status_t status = create_ctx(e, parent_ctx, arg_names, args, &fn_ctx);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_syntax_begin(e, fn_ctx, body);
+ lsp_mem_dec_ref(e->m, fn_ctx);
+ return status;
+}
+
+
+static lsp_status_t apply_syntax(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t callable, lsp_addr_t args) {
+ lsp_addr_t parent_ctx = lsp_mem_get_syntax_parent_ctx(e->m, callable);
+ lsp_addr_t arg_names = lsp_mem_get_syntax_args(e->m, callable);
+ lsp_addr_t body = lsp_mem_get_syntax_body(e->m, callable);
+
+ lsp_addr_t syntax_ctx;
+ lsp_status_t status =
+ create_ctx(e, parent_ctx, arg_names, args, &syntax_ctx);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t result = e->m->nil;
+ while (body != e->m->nil) {
+ lsp_mem_dec_ref(e->m, result);
+
+ lsp_addr_t value = lsp_mem_get_pair_first(e->m, body);
+ status = lsp_env_resolve(e, syntax_ctx, value, &result);
+ if (status != LSP_SUCCESS)
+ break;
+
+ body = lsp_mem_get_pair_second(e->m, body);
+ }
+
+ lsp_mem_dec_ref(e->m, syntax_ctx);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ // lsp_write(e->m, e->out, result);
+ // lsp_out_stream_write(e->out, '\n');
+
+ status = lsp_env_set_result_eval(e, ctx, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t callable,
+ lsp_addr_t args) {
+ if (lsp_mem_is_builtin_function(e->m, callable))
+ return apply_builtin_function(e, ctx, callable, args);
+
+ if (lsp_mem_is_builtin_syntax(e->m, callable))
+ return apply_builtin_syntax(e, ctx, callable, args);
+
+ if (lsp_mem_is_function(e->m, callable))
+ return apply_function(e, ctx, callable, args);
+
+ if (lsp_mem_is_syntax(e->m, callable))
+ return apply_syntax(e, ctx, callable, args);
+
+ return LSP_ERR_APPLY;
+}
diff --git a/src_c/apply.h b/src_c/apply.h
new file mode 100644
index 0000000..ef4e1c2
--- /dev/null
+++ b/src_c/apply.h
@@ -0,0 +1,10 @@
+#ifndef LISP16_APPLY_H
+#define LISP16_APPLY_H
+
+#include "env.h"
+
+
+lsp_status_t lsp_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t callable,
+ lsp_addr_t args);
+
+#endif
diff --git a/src_c/arch.h b/src_c/arch.h
new file mode 100644
index 0000000..01ae8d9
--- /dev/null
+++ b/src_c/arch.h
@@ -0,0 +1,63 @@
+#ifndef LISP16_ARCH_H
+#define LISP16_ARCH_H
+
+#define LSP_ARCH_POSIX 0
+#define LSP_ARCH_AVR8 1
+#define LSP_ARCH_STM32 2
+
+#ifndef LSP_ARCH
+#error LSP_ARCH not defined
+#endif
+
+#if LSP_ARCH == LSP_ARCH_POSIX
+
+#include <stdint.h>
+typedef _Bool lsp_bool_t;
+typedef int8_t lsp_int8_t;
+typedef int16_t lsp_int16_t;
+typedef int32_t lsp_int32_t;
+typedef uint8_t lsp_uint8_t;
+typedef uint16_t lsp_uint16_t;
+typedef uint32_t lsp_uint32_t;
+
+#elif LSP_ARCH == LSP_ARCH_AVR8
+
+#include <stdint.h>
+typedef _Bool lsp_bool_t;
+typedef int8_t lsp_int8_t;
+typedef int16_t lsp_int16_t;
+typedef int32_t lsp_int32_t;
+typedef uint8_t lsp_uint8_t;
+typedef uint16_t lsp_uint16_t;
+typedef uint32_t lsp_uint32_t;
+
+#elif LSP_ARCH == LSP_ARCH_STM32
+
+#include <stdint.h>
+typedef _Bool lsp_bool_t;
+typedef int8_t lsp_int8_t;
+typedef int16_t lsp_int16_t;
+typedef int32_t lsp_int32_t;
+typedef uint8_t lsp_uint8_t;
+typedef uint16_t lsp_uint16_t;
+typedef uint32_t lsp_uint32_t;
+
+#else
+
+#error unknown LSP_ARCH
+
+#endif
+
+#ifndef NULL
+#define NULL ((void *)0)
+#endif
+
+#ifndef true
+#define true ((lsp_bool_t)1)
+#endif
+
+#ifndef false
+#define false ((lsp_bool_t)0)
+#endif
+
+#endif
diff --git a/src_c/arch/avr8.c b/src_c/arch/avr8.c
new file mode 100644
index 0000000..cbc454b
--- /dev/null
+++ b/src_c/arch/avr8.c
@@ -0,0 +1,63 @@
+#include "avr8.h"
+#include <avr/io.h>
+
+#define MEM_SIZE 0x01c0
+#define UART_BAUD 9600
+
+
+static lsp_int16_t avr8_getchar(lsp_in_stream_t *s) {
+ while (!(UCSR0A & (1 << 7)))
+ ;
+ return UDR0;
+}
+
+
+static lsp_int16_t avr8_putchar(lsp_out_stream_t *s, lsp_int16_t c) {
+ while (!(UCSR0A & (1 << 5)))
+ ;
+ UDR0 = c;
+}
+
+
+static lsp_uint8_t avr8_mem[sizeof(lsp_mem_t) + MEM_SIZE * sizeof(lsp_cell_t)];
+
+static lsp_in_stream_t avr8_in_stream;
+
+static lsp_out_stream_t avr8_out_stream;
+
+
+void lsp_arch_avr8_init() {
+ UBRR0 = F_CPU / 16 / UART_BAUD - 1;
+ UCSR0B |= _BV(TXEN0) | _BV(RXEN0);
+}
+
+
+lsp_mem_t *lsp_arch_avr8_create_mem() {
+ lsp_mem_t *m = (void *)avr8_mem;
+ if (lsp_mem_init(m, MEM_SIZE) != LSP_SUCCESS)
+ return NULL;
+ return m;
+}
+
+
+void lsp_arch_avr8_free_mem(lsp_mem_t *m) {}
+
+
+lsp_in_stream_t *lsp_arch_avr8_create_in_stream() {
+ lsp_in_stream_t *s = &avr8_in_stream;
+ lsp_in_stream_init(s, avr8_getchar);
+ return s;
+}
+
+
+void lsp_arch_avr8_free_in_stream(lsp_in_stream_t *s) {}
+
+
+lsp_out_stream_t *lsp_arch_avr8_create_out_stream() {
+ lsp_out_stream_t *s = &avr8_out_stream;
+ lsp_out_stream_init(s, avr8_putchar);
+ return s;
+}
+
+
+void lsp_arch_avr8_free_out_stream(lsp_out_stream_t *s) {}
diff --git a/src_c/arch/avr8.h b/src_c/arch/avr8.h
new file mode 100644
index 0000000..351ee14
--- /dev/null
+++ b/src_c/arch/avr8.h
@@ -0,0 +1,30 @@
+#ifndef LISP16_ARCH_AVR8_H
+#define LISP16_ARCH_AVR8_H
+
+#include "../mem.h"
+#include "../stream.h"
+
+#define LSP_ARCH_INIT lsp_arch_avr8_init
+
+#define LSP_ARCH_CREATE_MEM lsp_arch_avr8_create_mem
+#define LSP_ARCH_FREE_MEM lsp_arch_avr8_free_mem
+
+#define LSP_ARCH_CREATE_IN_STREAM lsp_arch_avr8_create_in_stream
+#define LSP_ARCH_FREE_IN_STREAM lsp_arch_avr8_free_in_stream
+
+#define LSP_ARCH_CREATE_OUT_STREAM lsp_arch_avr8_create_out_stream
+#define LSP_ARCH_FREE_OUT_STREAM lsp_arch_avr8_free_out_stream
+
+
+void lsp_arch_avr8_init();
+
+lsp_mem_t *lsp_arch_avr8_create_mem();
+void lsp_arch_avr8_free_mem(lsp_mem_t *m);
+
+lsp_in_stream_t *lsp_arch_avr8_create_in_stream();
+void lsp_arch_avr8_free_in_stream(lsp_in_stream_t *s);
+
+lsp_out_stream_t *lsp_arch_avr8_create_out_stream();
+void lsp_arch_avr8_free_out_stream(lsp_out_stream_t *s);
+
+#endif
diff --git a/src_c/arch/posix.c b/src_c/arch/posix.c
new file mode 100644
index 0000000..19e33a1
--- /dev/null
+++ b/src_c/arch/posix.c
@@ -0,0 +1,54 @@
+#include "posix.h"
+#include <stdio.h>
+#include <stdlib.h>
+
+#define MEM_SIZE 0x4000
+
+
+static lsp_int16_t posix_getchar(lsp_in_stream_t *s) {
+ int c = getchar();
+ if (c == EOF)
+ return LSP_EOF;
+ return c;
+}
+
+
+static lsp_int16_t posix_putchar(lsp_out_stream_t *s, lsp_int16_t c) {
+ return putchar(c);
+}
+
+
+void lsp_arch_posix_init() {}
+
+
+lsp_mem_t *lsp_arch_posix_create_mem() {
+ lsp_mem_t *m = malloc(sizeof(lsp_mem_t) + sizeof(lsp_cell_t) * MEM_SIZE);
+ if (lsp_mem_init(m, MEM_SIZE) != LSP_SUCCESS) {
+ free(m);
+ return NULL;
+ }
+ return m;
+}
+
+
+void lsp_arch_posix_free_mem(lsp_mem_t *m) { free(m); }
+
+
+lsp_in_stream_t *lsp_arch_posix_create_in_stream() {
+ lsp_in_stream_t *s = malloc(sizeof(lsp_in_stream_t));
+ lsp_in_stream_init(s, posix_getchar);
+ return s;
+}
+
+
+void lsp_arch_posix_free_in_stream(lsp_in_stream_t *s) { free(s); }
+
+
+lsp_out_stream_t *lsp_arch_posix_create_out_stream() {
+ lsp_out_stream_t *s = malloc(sizeof(lsp_out_stream_t));
+ lsp_out_stream_init(s, posix_putchar);
+ return s;
+}
+
+
+void lsp_arch_posix_free_out_stream(lsp_out_stream_t *s) { free(s); }
diff --git a/src_c/arch/posix.h b/src_c/arch/posix.h
new file mode 100644
index 0000000..5716c0a
--- /dev/null
+++ b/src_c/arch/posix.h
@@ -0,0 +1,30 @@
+#ifndef LISP16_ARCH_POSIX_H
+#define LISP16_ARCH_POSIX_H
+
+#include "../mem.h"
+#include "../stream.h"
+
+#define LSP_ARCH_INIT lsp_arch_posix_init
+
+#define LSP_ARCH_CREATE_MEM lsp_arch_posix_create_mem
+#define LSP_ARCH_FREE_MEM lsp_arch_posix_free_mem
+
+#define LSP_ARCH_CREATE_IN_STREAM lsp_arch_posix_create_in_stream
+#define LSP_ARCH_FREE_IN_STREAM lsp_arch_posix_free_in_stream
+
+#define LSP_ARCH_CREATE_OUT_STREAM lsp_arch_posix_create_out_stream
+#define LSP_ARCH_FREE_OUT_STREAM lsp_arch_posix_free_out_stream
+
+
+void lsp_arch_posix_init();
+
+lsp_mem_t *lsp_arch_posix_create_mem();
+void lsp_arch_posix_free_mem(lsp_mem_t *m);
+
+lsp_in_stream_t *lsp_arch_posix_create_in_stream();
+void lsp_arch_posix_free_in_stream(lsp_in_stream_t *s);
+
+lsp_out_stream_t *lsp_arch_posix_create_out_stream();
+void lsp_arch_posix_free_out_stream(lsp_out_stream_t *s);
+
+#endif
diff --git a/src_c/buff.c b/src_c/buff.c
new file mode 100644
index 0000000..e22eba8
--- /dev/null
+++ b/src_c/buff.c
@@ -0,0 +1,61 @@
+#include "buff.h"
+
+
+static lsp_status_t update_str(lsp_buff_t *b) {
+ lsp_uint16_t value_len =
+ ((b->value == b->m->nil) ? 0 : lsp_mem_get_string_len(b->m, b->value));
+
+ lsp_addr_t value;
+ lsp_status_t status =
+ lsp_mem_create_string(b->m, value_len + b->buff_len, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ for (lsp_uint16_t i = 0; i < value_len; ++i)
+ lsp_mem_set_string_data(b->m, value, i,
+ lsp_mem_get_string_data(b->m, b->value, i));
+
+ for (lsp_uint16_t i = 0; i < b->buff_len; ++i)
+ lsp_mem_set_string_data(b->m, value, i + value_len, b->buff[i]);
+
+ lsp_mem_dec_ref(b->m, b->value);
+ b->value = value;
+ b->buff_len = 0;
+ return LSP_SUCCESS;
+}
+
+
+void lsp_buff_init(lsp_buff_t *b, lsp_mem_t *m) {
+ b->m = m;
+ b->value = m->nil;
+ b->buff_len = 0;
+}
+
+
+lsp_status_t lsp_buff_push(lsp_buff_t *b, lsp_uint8_t c) {
+ if (b->buff_len + 1 >= LSP_BUFF_SIZE) {
+ lsp_status_t status = update_str(b);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ b->buff[b->buff_len++] = c;
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_buff_pop(lsp_buff_t *b, lsp_addr_t *value) {
+ lsp_status_t status = update_str(b);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ *value = b->value;
+ b->value = b->m->nil;
+ return LSP_SUCCESS;
+}
+
+
+void lsp_buff_clear(lsp_buff_t *b) {
+ lsp_mem_dec_ref(b->m, b->value);
+ b->value = b->m->nil;
+}
diff --git a/src_c/buff.h b/src_c/buff.h
new file mode 100644
index 0000000..d17694c
--- /dev/null
+++ b/src_c/buff.h
@@ -0,0 +1,23 @@
+#ifndef LISP16_BUFF_H
+#define LISP16_BUFF_H
+
+#include "mem.h"
+#include "status.h"
+
+#define LSP_BUFF_SIZE 32
+
+
+typedef struct {
+ lsp_mem_t *m;
+ lsp_addr_t value;
+ lsp_uint8_t buff[LSP_BUFF_SIZE];
+ lsp_uint8_t buff_len;
+} lsp_buff_t;
+
+
+void lsp_buff_init(lsp_buff_t *b, lsp_mem_t *m);
+lsp_status_t lsp_buff_push(lsp_buff_t *b, lsp_uint8_t c);
+lsp_status_t lsp_buff_pop(lsp_buff_t *b, lsp_addr_t *value);
+void lsp_buff_clear(lsp_buff_t *b);
+
+#endif
diff --git a/src_c/builtin.c b/src_c/builtin.c
new file mode 100644
index 0000000..92e1fa8
--- /dev/null
+++ b/src_c/builtin.c
@@ -0,0 +1,65 @@
+#include "builtin.h"
+
+
+lsp_status_t lsp_builtin_get_args_1(lsp_mem_t *m, lsp_addr_t args,
+ lsp_addr_t *arg1) {
+ if (args == m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ *arg1 = lsp_mem_get_pair_first(m, args);
+
+ args = lsp_mem_get_pair_second(m, args);
+ if (args != m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_builtin_get_args_2(lsp_mem_t *m, lsp_addr_t args,
+ lsp_addr_t *arg1, lsp_addr_t *arg2) {
+ if (args == m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ *arg1 = lsp_mem_get_pair_first(m, args);
+
+ args = lsp_mem_get_pair_second(m, args);
+ if (args == m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ *arg2 = lsp_mem_get_pair_first(m, args);
+
+ args = lsp_mem_get_pair_second(m, args);
+ if (args != m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_builtin_get_args_3(lsp_mem_t *m, lsp_addr_t args,
+ lsp_addr_t *arg1, lsp_addr_t *arg2,
+ lsp_addr_t *arg3) {
+ if (args == m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ *arg1 = lsp_mem_get_pair_first(m, args);
+
+ args = lsp_mem_get_pair_second(m, args);
+ if (args == m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ *arg2 = lsp_mem_get_pair_first(m, args);
+
+ args = lsp_mem_get_pair_second(m, args);
+ if (args == m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ *arg3 = lsp_mem_get_pair_first(m, args);
+
+ args = lsp_mem_get_pair_second(m, args);
+ if (args != m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ return LSP_SUCCESS;
+}
diff --git a/src_c/builtin.h b/src_c/builtin.h
new file mode 100644
index 0000000..af9fb51
--- /dev/null
+++ b/src_c/builtin.h
@@ -0,0 +1,24 @@
+#ifndef LISP16_BUILTIN_H
+#define LISP16_BUILTIN_H
+
+#include "env.h"
+
+
+typedef lsp_status_t (*lsp_builtin_cb_t)(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+
+typedef struct {
+ char *name;
+ lsp_builtin_cb_t cb;
+} lsp_builtin_entry_t;
+
+
+lsp_status_t lsp_builtin_get_args_1(lsp_mem_t *m, lsp_addr_t args,
+ lsp_addr_t *arg1);
+lsp_status_t lsp_builtin_get_args_2(lsp_mem_t *m, lsp_addr_t args,
+ lsp_addr_t *arg1, lsp_addr_t *arg2);
+lsp_status_t lsp_builtin_get_args_3(lsp_mem_t *m, lsp_addr_t args,
+ lsp_addr_t *arg1, lsp_addr_t *arg2,
+ lsp_addr_t *arg3);
+
+#endif
diff --git a/src_c/cell.c b/src_c/cell.c
new file mode 100644
index 0000000..66da137
--- /dev/null
+++ b/src_c/cell.c
@@ -0,0 +1,50 @@
+#include "cell.h"
+
+
+lsp_uint16_t lsp_cell_get_size(lsp_cell_t *c) {
+ if (lsp_cell_is_number(c)) {
+ if (!(c[0] & 0x2000))
+ return 1;
+
+ for (lsp_uint8_t i = 1; true; ++i) {
+ if (!(c[i] & 0x4000))
+ return i + 1;
+ }
+
+ } else if (lsp_cell_is_pair(c)) {
+ return 2;
+
+ } else if (lsp_cell_is_string_or_symbol(c)) {
+ return lsp_cell_get_string_symbol_size(*c & 0x07ff);
+
+ } else if (lsp_cell_is_builtin(c)) {
+ return 1;
+
+ } else if (lsp_cell_is_function_or_syntax(c)) {
+ return 4;
+ }
+
+ return 0;
+}
+
+
+lsp_uint16_t lsp_cell_get_number_size(lsp_int32_t value) {
+ lsp_bool_t msb = ((value & 0x1000) ? true : false);
+ value >>= 13;
+ if (value == 0 || value == -1)
+ return 1 + ((msb && !value) ? 1 : 0);
+
+ for (lsp_uint8_t i = 0; 1; ++i) {
+ msb = ((value & 0x4000) ? 1 : 0);
+ value >>= 15;
+ if (value == 0 || value == -1)
+ return i + 2 + ((msb && !value) ? 1 : 0);
+ }
+
+ return 0;
+}
+
+
+lsp_uint16_t lsp_cell_get_string_symbol_size(lsp_uint16_t len) {
+ return (((lsp_uint32_t)len << 3) / 15) + ((len % 15) ? 1 : 0) + 1;
+}
diff --git a/src_c/cell.h b/src_c/cell.h
new file mode 100644
index 0000000..b8ed7c0
--- /dev/null
+++ b/src_c/cell.h
@@ -0,0 +1,215 @@
+#ifndef LISP16_CELL_H
+#define LISP16_CELL_H
+
+#include "arch.h"
+
+
+typedef lsp_uint16_t lsp_cell_t;
+typedef lsp_uint16_t lsp_addr_t; // 14 least significant bits used
+
+
+lsp_uint16_t lsp_cell_get_size(lsp_cell_t *c);
+lsp_uint16_t lsp_cell_get_number_size(lsp_int32_t value);
+lsp_uint16_t lsp_cell_get_string_symbol_size(lsp_uint16_t len);
+
+
+static inline lsp_bool_t lsp_cell_is_number(lsp_cell_t *c) {
+ return (*c & 0x4000) == 0x0000;
+}
+
+static inline lsp_bool_t lsp_cell_is_pair(lsp_cell_t *c) {
+ return (*c & 0x6000) == 0x4000;
+}
+
+static inline lsp_bool_t lsp_cell_is_string(lsp_cell_t *c) {
+ return (*c & 0x7800) == 0x6000;
+}
+
+static inline lsp_bool_t lsp_cell_is_symbol(lsp_cell_t *c) {
+ return (*c & 0x7800) == 0x6800;
+}
+
+static inline lsp_bool_t lsp_cell_is_builtin_function(lsp_cell_t *c) {
+ return (*c & 0x7c00) == 0x7000;
+}
+
+static inline lsp_bool_t lsp_cell_is_builtin_syntax(lsp_cell_t *c) {
+ return (*c & 0x7c00) == 0x7400;
+}
+
+static inline lsp_bool_t lsp_cell_is_function(lsp_cell_t *c) {
+ return (*c & 0x7c00) == 0x7800;
+}
+
+static inline lsp_bool_t lsp_cell_is_syntax(lsp_cell_t *c) {
+ return (*c & 0x7c00) == 0x7c00;
+}
+
+static inline lsp_bool_t lsp_cell_is_string_or_symbol(lsp_cell_t *c) {
+ return (*c & 0x7000) == 0x6000;
+}
+
+static inline lsp_bool_t lsp_cell_is_builtin(lsp_cell_t *c) {
+ return (*c & 0x7800) == 0x7000;
+}
+
+static inline lsp_bool_t lsp_cell_is_function_or_syntax(lsp_cell_t *c) {
+ return (*c & 0x7800) == 0x7800;
+}
+
+
+static inline void lsp_cell_set_number(lsp_cell_t *c, lsp_int32_t value) {
+ lsp_uint8_t size = lsp_cell_get_number_size(value);
+ for (lsp_uint8_t i = 0; i < size; ++i) {
+ lsp_uint8_t shift = (size - i - 1) * 14;
+ c[i] = (value >> shift) & (i ? 0x3fff : 0x1fff);
+ if (i != size - 1)
+ c[i] |= (i ? 0x4000 : 0x2000);
+ }
+}
+
+static inline void lsp_cell_set_pair(lsp_cell_t *c, lsp_addr_t first,
+ lsp_addr_t second) {
+ c[0] = 0x4000 | ((first >> 1) & 0x1fff);
+ c[1] = ((first & 1) ? 0x4000 : 0) | (second & 0x3fff);
+}
+
+static inline void lsp_cell_set_string(lsp_cell_t *c, lsp_uint16_t data_len) {
+ lsp_uint16_t size = lsp_cell_get_string_symbol_size(data_len);
+ c[0] = 0x6000 | (data_len & 0x07ff);
+ for (lsp_uint16_t i = 1; i < size; ++i)
+ c[i] = 0;
+}
+
+static inline void lsp_cell_set_string_data(lsp_cell_t *c, lsp_uint16_t i,
+ lsp_uint8_t data_i) {
+ lsp_uint32_t bit_count = (lsp_uint32_t)i << 3;
+ lsp_uint16_t start_cell = bit_count / 15;
+ lsp_uint8_t bit_shift = bit_count % 15;
+ lsp_uint16_t mask = 0x7f80 >> bit_shift;
+ if (bit_shift < 8) {
+ c[1 + start_cell] = (c[1 + start_cell] & ~mask) |
+ ((lsp_uint16_t)data_i << (7 - bit_shift));
+ } else {
+ c[1 + start_cell] =
+ (c[1 + start_cell] & ~mask) | (data_i >> (bit_shift - 7));
+ bit_shift = 22 - bit_shift;
+ mask = (0xffff << bit_shift) & 0x7fff;
+ c[2 + start_cell] = (c[2 + start_cell] & ~mask) |
+ (((lsp_uint16_t)data_i << bit_shift) & mask);
+ }
+}
+
+static inline void lsp_cell_set_symbol(lsp_cell_t *c, lsp_uint16_t name_len) {
+ lsp_uint16_t size = lsp_cell_get_string_symbol_size(name_len);
+ c[0] = 0x6800 | (name_len & 0x07ff);
+ for (lsp_uint16_t i = 1; i < size; ++i)
+ c[i] = 0;
+}
+
+static inline void lsp_cell_set_symbol_name(lsp_cell_t *c, lsp_uint16_t i,
+ lsp_uint8_t name_i) {
+ lsp_cell_set_string_data(c, i, name_i);
+}
+
+static inline void lsp_cell_set_builtin_function(lsp_cell_t *c,
+ lsp_uint16_t index) {
+ *c = 0x7000 | (index & 0x03ff);
+}
+
+static inline void lsp_cell_set_builtin_syntax(lsp_cell_t *c,
+ lsp_uint16_t index) {
+ *c = 0x7400 | (index & 0x03ff);
+}
+
+static inline void lsp_cell_set_function(lsp_cell_t *c, lsp_addr_t parent_ctx,
+ lsp_addr_t args, lsp_addr_t body) {
+ c[0] = 0x7800;
+ c[1] = parent_ctx & 0x3fff;
+ c[2] = args & 0x3fff;
+ c[3] = body & 0x3fff;
+}
+
+static inline void lsp_cell_set_syntax(lsp_cell_t *c, lsp_addr_t parent_ctx,
+ lsp_addr_t args, lsp_addr_t body) {
+ c[0] = 0x7c00;
+ c[1] = parent_ctx & 0x3fff;
+ c[2] = args & 0x3fff;
+ c[3] = body & 0x3fff;
+}
+
+
+static inline lsp_int32_t lsp_cell_get_number(lsp_cell_t *c) {
+ lsp_int32_t v = ((c[0] & 0x1000) ? -1 : 0);
+ v = (v << 12) | (c[0] & 0x0fff);
+ if (!(c[0] & 0x2000))
+ return v;
+ for (lsp_uint8_t i = 1; 1; ++i) {
+ v = (v << 14) | (c[1] & 0x3fff);
+ if (!(c[i] & 0x4000))
+ return v;
+ }
+}
+
+static inline lsp_addr_t lsp_cell_get_pair_first(lsp_cell_t *c) {
+ return ((c[0] & 0x1fff) << 1) + ((c[1] & 0x4000) ? 1 : 0);
+}
+
+static inline lsp_addr_t lsp_cell_get_pair_second(lsp_cell_t *c) {
+ return c[1] & 0x3fff;
+}
+
+static inline lsp_uint16_t lsp_cell_get_string_len(lsp_cell_t *c) {
+ return *c & 0x07ff;
+}
+
+static inline lsp_uint8_t lsp_cell_get_string_data(lsp_cell_t *c,
+ lsp_uint16_t i) {
+ lsp_uint32_t bit_count = (lsp_uint32_t)i << 3;
+ lsp_uint16_t start_cell = bit_count / 15;
+ lsp_uint8_t start_bit = 14 - (bit_count % 15);
+ if (start_bit >= 7)
+ return (c[1 + start_cell] >> (start_bit - 7)) & 0xff;
+ return ((c[1 + start_cell] << (7 - start_bit)) |
+ ((c[2 + start_cell] & 0x7fff) >> (8 + start_bit))) &
+ 0xff;
+}
+
+static inline lsp_uint16_t lsp_cell_get_symbol_len(lsp_cell_t *c) {
+ return lsp_cell_get_string_len(c);
+}
+
+static inline lsp_uint8_t lsp_cell_get_symbol_name(lsp_cell_t *c,
+ lsp_uint16_t i) {
+ return lsp_cell_get_string_data(c, i);
+}
+
+static inline lsp_uint16_t lsp_cell_get_builtin_index(lsp_cell_t *c) {
+ return *c & 0x03ff;
+}
+
+static inline lsp_addr_t lsp_cell_get_function_parent_ctx(lsp_cell_t *c) {
+ return c[1] & 0x3fff;
+}
+
+static inline lsp_addr_t lsp_cell_get_function_args(lsp_cell_t *c) {
+ return c[2] & 0x3fff;
+}
+
+static inline lsp_addr_t lsp_cell_get_function_body(lsp_cell_t *c) {
+ return c[3] & 0x3fff;
+}
+
+static inline lsp_addr_t lsp_cell_get_syntax_parent_ctx(lsp_cell_t *c) {
+ return lsp_cell_get_function_parent_ctx(c);
+}
+
+static inline lsp_addr_t lsp_cell_get_syntax_args(lsp_cell_t *c) {
+ return lsp_cell_get_function_args(c);
+}
+
+static inline lsp_addr_t lsp_cell_get_syntax_body(lsp_cell_t *c) {
+ return lsp_cell_get_function_body(c);
+}
+
+#endif
diff --git a/src_c/ctx.c b/src_c/ctx.c
new file mode 100644
index 0000000..693ea53
--- /dev/null
+++ b/src_c/ctx.c
@@ -0,0 +1,231 @@
+#include "ctx.h"
+#include "function.h"
+#include "syntax.h"
+
+
+static lsp_bool_t contains_symbol(lsp_mem_t *m, lsp_addr_t ctx,
+ lsp_addr_t symbol) {
+ while (ctx != m->nil) {
+ lsp_addr_t entry = lsp_mem_get_pair_first(m, ctx);
+ lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
+
+ if (lsp_mem_eq(m, entry_symbol, symbol))
+ return true;
+
+ ctx = lsp_mem_get_pair_second(m, ctx);
+ }
+
+ return false;
+}
+
+
+static lsp_status_t remove_symbol(lsp_mem_t *m, lsp_addr_t ctx,
+ lsp_addr_t symbol) {
+ lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
+
+ lsp_addr_t result = m->nil;
+ lsp_addr_t result_last = m->nil;
+ lsp_status_t status = LSP_SUCCESS;
+
+ while (list != m->nil) {
+ lsp_addr_t entry = lsp_mem_get_pair_first(m, list);
+ lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
+ list = lsp_mem_get_pair_second(m, list);
+
+ if (lsp_mem_eq(m, entry_symbol, symbol)) {
+ if (result == m->nil) {
+ result = list;
+ status = lsp_mem_inc_ref(m, list);
+
+ } else {
+ lsp_mem_set_pair_second(m, result_last, list);
+ }
+
+ break;
+ }
+
+ lsp_addr_t new_result_last;
+ status = lsp_mem_create_pair(m, entry, m->nil, &new_result_last);
+ if (status != LSP_SUCCESS)
+ break;
+
+ if (result == m->nil) {
+ result = new_result_last;
+
+ } else {
+ lsp_mem_set_pair_second(m, result_last, new_result_last);
+ lsp_mem_dec_ref(m, new_result_last);
+ }
+
+ result_last = new_result_last;
+ }
+
+ if (status == LSP_SUCCESS)
+ lsp_mem_set_pair_first(m, ctx, result);
+
+ lsp_mem_dec_ref(m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_ctx_create(lsp_mem_t *m, lsp_addr_t *ctx) {
+ lsp_addr_t list = m->nil;
+ lsp_addr_t list_last = m->nil;
+ lsp_status_t status = LSP_SUCCESS;
+
+ for (uint8_t i = 0; status == LSP_SUCCESS && lsp_syntaxes[i].name; ++i) {
+ lsp_addr_t symbol;
+ status =
+ lsp_mem_create_symbol_from_char(m, lsp_syntaxes[i].name, &symbol);
+ if (status != LSP_SUCCESS)
+ break;
+
+ lsp_addr_t value;
+ status = lsp_mem_create_builtin_syntax(m, i, &value);
+ if (status != LSP_SUCCESS) {
+ lsp_mem_dec_ref(m, symbol);
+ break;
+ }
+
+ lsp_addr_t entry;
+ status = lsp_mem_create_pair(m, symbol, value, &entry);
+ lsp_mem_dec_ref(m, symbol);
+ lsp_mem_dec_ref(m, value);
+ if (status != LSP_SUCCESS)
+ break;
+
+ lsp_addr_t new_list_last;
+ status = lsp_mem_create_pair(m, entry, m->nil, &new_list_last);
+ lsp_mem_dec_ref(m, entry);
+ if (status != LSP_SUCCESS)
+ break;
+
+ if (list == m->nil) {
+ list = new_list_last;
+
+ } else {
+ lsp_mem_set_pair_second(m, list_last, new_list_last);
+ lsp_mem_dec_ref(m, new_list_last);
+ }
+
+ list_last = new_list_last;
+ }
+
+ for (uint8_t i = 0; status == LSP_SUCCESS && lsp_functions[i].name; ++i) {
+ lsp_addr_t symbol;
+ status =
+ lsp_mem_create_symbol_from_char(m, lsp_functions[i].name, &symbol);
+ if (status != LSP_SUCCESS)
+ break;
+
+ lsp_addr_t value;
+ status = lsp_mem_create_builtin_function(m, i, &value);
+ if (status != LSP_SUCCESS) {
+ lsp_mem_dec_ref(m, symbol);
+ break;
+ }
+
+ lsp_addr_t entry;
+ status = lsp_mem_create_pair(m, symbol, value, &entry);
+ lsp_mem_dec_ref(m, symbol);
+ lsp_mem_dec_ref(m, value);
+ if (status != LSP_SUCCESS)
+ break;
+
+ lsp_addr_t new_list_last;
+ status = lsp_mem_create_pair(m, entry, m->nil, &new_list_last);
+ lsp_mem_dec_ref(m, entry);
+ if (status != LSP_SUCCESS)
+ break;
+
+ if (list == m->nil) {
+ list = new_list_last;
+
+ } else {
+ lsp_mem_set_pair_second(m, list_last, new_list_last);
+ lsp_mem_dec_ref(m, new_list_last);
+ }
+
+ list_last = new_list_last;
+ }
+
+ if (status == LSP_SUCCESS)
+ status = lsp_mem_create_pair(m, list, m->nil, ctx);
+
+ lsp_mem_dec_ref(m, list);
+ return status;
+}
+
+
+lsp_status_t lsp_ctx_copy(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t *result) {
+ lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
+ return lsp_mem_create_pair(m, list, m->nil, result);
+}
+
+
+lsp_status_t lsp_ctx_add(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
+ lsp_addr_t value) {
+ lsp_status_t status;
+
+ if (contains_symbol(m, ctx, symbol)) {
+ status = remove_symbol(m, ctx, symbol);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
+
+ lsp_addr_t entry;
+ status = lsp_mem_create_pair(m, symbol, value, &entry);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_mem_create_pair(m, entry, list, &list);
+ lsp_mem_dec_ref(m, entry);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_mem_set_pair_first(m, ctx, list);
+ lsp_mem_dec_ref(m, list);
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_ctx_set(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
+ lsp_addr_t value) {
+ lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
+
+ while (list != m->nil) {
+ lsp_addr_t entry = lsp_mem_get_pair_first(m, list);
+ lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
+
+ if (lsp_mem_eq(m, symbol, entry_symbol)) {
+ lsp_mem_set_pair_second(m, entry, value);
+ return LSP_SUCCESS;
+ }
+
+ list = lsp_mem_get_pair_second(m, list);
+ }
+
+ return LSP_ERR_CTX;
+}
+
+
+lsp_status_t lsp_ctx_get(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
+ lsp_addr_t *value) {
+ lsp_addr_t list = lsp_mem_get_pair_first(m, ctx);
+
+ while (list != m->nil) {
+ lsp_addr_t entry = lsp_mem_get_pair_first(m, list);
+ lsp_addr_t entry_symbol = lsp_mem_get_pair_first(m, entry);
+
+ if (lsp_mem_eq(m, symbol, entry_symbol)) {
+ *value = lsp_mem_get_pair_second(m, entry);
+ return lsp_mem_inc_ref(m, *value);
+ }
+
+ list = lsp_mem_get_pair_second(m, list);
+ }
+
+ return LSP_ERR_CTX;
+}
diff --git a/src_c/ctx.h b/src_c/ctx.h
new file mode 100644
index 0000000..02740a0
--- /dev/null
+++ b/src_c/ctx.h
@@ -0,0 +1,16 @@
+#ifndef LISP16_CTX_H
+#define LISP16_CTX_H
+
+#include "mem.h"
+
+
+lsp_status_t lsp_ctx_create(lsp_mem_t *m, lsp_addr_t *ctx);
+lsp_status_t lsp_ctx_copy(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t *result);
+lsp_status_t lsp_ctx_add(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
+ lsp_addr_t value);
+lsp_status_t lsp_ctx_set(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
+ lsp_addr_t value);
+lsp_status_t lsp_ctx_get(lsp_mem_t *m, lsp_addr_t ctx, lsp_addr_t symbol,
+ lsp_addr_t *value);
+
+#endif
diff --git a/src_c/env.c b/src_c/env.c
new file mode 100644
index 0000000..13999d5
--- /dev/null
+++ b/src_c/env.c
@@ -0,0 +1,86 @@
+#include "env.h"
+#include "ctx.h"
+#include "eval.h"
+
+
+static void init_result(lsp_env_t *e) {
+ e->result.is_value = true;
+ e->result.ctx = e->m->nil;
+ e->result.value = e->m->nil;
+}
+
+
+static void release_result(lsp_env_t *e) {
+ lsp_mem_dec_ref(e->m, e->result.ctx);
+ lsp_mem_dec_ref(e->m, e->result.value);
+
+ init_result(e);
+}
+
+
+void lsp_env_init(lsp_env_t *e, lsp_mem_t *m, lsp_in_stream_t *in,
+ lsp_out_stream_t *out) {
+ e->m = m;
+ e->in = in;
+ e->out = out;
+
+ init_result(e);
+}
+
+
+lsp_status_t lsp_env_set_result_value(lsp_env_t *e, lsp_addr_t value) {
+ release_result(e);
+
+ lsp_status_t status = lsp_mem_inc_ref(e->m, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ e->result.is_value = true;
+ e->result.value = value;
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_env_set_result_eval(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t value) {
+ release_result(e);
+
+ lsp_status_t status = lsp_mem_inc_ref(e->m, ctx);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_mem_inc_ref(e->m, value);
+ if (status != LSP_SUCCESS) {
+ lsp_mem_dec_ref(e->m, ctx);
+ return status;
+ }
+
+ e->result.is_value = false;
+ e->result.ctx = ctx;
+ e->result.value = value;
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_env_resolve(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value,
+ lsp_addr_t *result) {
+ lsp_status_t status = lsp_env_set_result_eval(e, ctx, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ while (!e->result.is_value) {
+ lsp_addr_t eval_ctx = e->result.ctx;
+ lsp_addr_t eval_value = e->result.value;
+ init_result(e);
+
+ status = lsp_eval(e, eval_ctx, eval_value);
+ lsp_mem_dec_ref(e->m, eval_ctx);
+ lsp_mem_dec_ref(e->m, eval_value);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ *result = e->result.value;
+ init_result(e);
+ return LSP_SUCCESS;
+}
diff --git a/src_c/env.h b/src_c/env.h
new file mode 100644
index 0000000..026cd18
--- /dev/null
+++ b/src_c/env.h
@@ -0,0 +1,30 @@
+#ifndef LISP16_ENV_H
+#define LISP16_ENV_H
+
+#include "mem.h"
+#include "stream.h"
+
+
+typedef struct {
+ lsp_mem_t *m;
+ lsp_in_stream_t *in;
+ lsp_out_stream_t *out;
+
+ // internal
+ struct {
+ lsp_bool_t is_value;
+ lsp_addr_t ctx;
+ lsp_addr_t value;
+ } result;
+} lsp_env_t;
+
+
+void lsp_env_init(lsp_env_t *e, lsp_mem_t *m, lsp_in_stream_t *in,
+ lsp_out_stream_t *out);
+lsp_status_t lsp_env_set_result_value(lsp_env_t *e, lsp_addr_t value);
+lsp_status_t lsp_env_set_result_eval(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t value);
+lsp_status_t lsp_env_resolve(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value,
+ lsp_addr_t *result);
+
+#endif
diff --git a/src_c/eval.c b/src_c/eval.c
new file mode 100644
index 0000000..e04537e
--- /dev/null
+++ b/src_c/eval.c
@@ -0,0 +1,92 @@
+#include "eval.h"
+#include "ctx.h"
+#include "apply.h"
+
+
+static lsp_status_t eval_args(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args,
+ lsp_addr_t *result) {
+ lsp_addr_t last = e->m->nil;
+ *result = e->m->nil;
+ lsp_status_t status;
+
+ while (args != e->m->nil) {
+ lsp_addr_t arg = lsp_mem_get_pair_first(e->m, args);
+ status = lsp_env_resolve(e, ctx, arg, &arg);
+ if (status != LSP_SUCCESS)
+ goto error;
+
+ lsp_addr_t new_last;
+ status = lsp_mem_create_pair(e->m, arg, e->m->nil, &new_last);
+ lsp_mem_dec_ref(e->m, arg);
+ if (status != LSP_SUCCESS)
+ goto error;
+
+ if (*result == e->m->nil) {
+ *result = new_last;
+
+ } else {
+ lsp_mem_set_pair_second(e->m, last, new_last);
+ lsp_mem_dec_ref(e->m, new_last);
+ }
+
+ last = new_last;
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ return LSP_SUCCESS;
+
+error:
+ lsp_mem_dec_ref(e->m, *result);
+ return status;
+}
+
+
+lsp_status_t lsp_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value) {
+ lsp_status_t status = LSP_SUCCESS;
+
+ if (lsp_mem_is_number(e->m, value) || lsp_mem_is_string(e->m, value) ||
+ lsp_mem_is_builtin(e->m, value) ||
+ lsp_mem_is_function_or_syntax(e->m, value))
+ return lsp_env_set_result_value(e, value);
+
+ if (lsp_mem_is_symbol(e->m, value)) {
+ lsp_addr_t result;
+ status = lsp_ctx_get(e->m, ctx, value, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+ }
+
+ if (lsp_mem_is_pair(e->m, value)) {
+ if (value == e->m->nil)
+ return lsp_env_set_result_value(e, e->m->nil);
+
+ lsp_addr_t callable = lsp_mem_get_pair_first(e->m, value);
+ lsp_addr_t args = lsp_mem_get_pair_second(e->m, value);
+
+ status = lsp_env_resolve(e, ctx, callable, &callable);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (lsp_mem_is_builtin_function(e->m, callable) ||
+ lsp_mem_is_function(e->m, callable)) {
+ status = eval_args(e, ctx, args, &args);
+ } else {
+ status = lsp_mem_inc_ref(e->m, args);
+ }
+ if (status != LSP_SUCCESS) {
+ lsp_mem_dec_ref(e->m, callable);
+ return status;
+ }
+
+ status = lsp_apply(e, ctx, callable, args);
+ lsp_mem_dec_ref(e->m, callable);
+ lsp_mem_dec_ref(e->m, args);
+ return status;
+ }
+
+ return LSP_ERR_EVAL;
+}
diff --git a/src_c/eval.h b/src_c/eval.h
new file mode 100644
index 0000000..4f40270
--- /dev/null
+++ b/src_c/eval.h
@@ -0,0 +1,9 @@
+#ifndef LISP16_EVAL_H
+#define LISP16_EVAL_H
+
+#include "env.h"
+
+
+lsp_status_t lsp_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t value);
+
+#endif
diff --git a/src_c/function.c b/src_c/function.c
new file mode 100644
index 0000000..075261a
--- /dev/null
+++ b/src_c/function.c
@@ -0,0 +1,582 @@
+#include "function.h"
+#include "apply.h"
+#include "eval.h"
+#include "read.h"
+#include "write.h"
+
+
+lsp_builtin_entry_t lsp_functions[] = {
+ {"eval", lsp_function_eval},
+ {"apply", lsp_function_apply},
+ {"error", lsp_function_error},
+ {"cons", lsp_function_cons},
+ {"set-car!", lsp_function_set_car},
+ {"set-cdr!", lsp_function_set_cdr},
+ {"number?", lsp_function_is_number},
+ {"pair?", lsp_function_is_pair},
+ {"string?", lsp_function_is_string},
+ {"symbol?", lsp_function_is_symbol},
+ {"function?", lsp_function_is_function},
+ {"syntax?", lsp_function_is_syntax},
+ {"eq?", lsp_function_eq},
+ {"equal?", lsp_function_equal},
+ {">", lsp_function_gt},
+ {"<", lsp_function_lt},
+ {"+", lsp_function_plus},
+ {"-", lsp_function_minus},
+ {"*", lsp_function_multiply},
+ {"/", lsp_function_divide},
+ {"read", lsp_function_read},
+ {"read-u8", lsp_function_read_u8},
+ {"peek-u8", lsp_function_peek_u8},
+ {"write", lsp_function_write},
+ {"write-u8", lsp_function_write_u8},
+ {"make-string", lsp_function_make_string},
+ {"string-length", lsp_function_string_length},
+ {"string-ref", lsp_function_string_ref},
+ {"string-set!", lsp_function_string_set},
+ {NULL, NULL}};
+
+
+lsp_status_t lsp_function_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_eval(e, ctx, value);
+}
+
+
+lsp_status_t lsp_function_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t callable;
+ lsp_addr_t arguments;
+ lsp_status_t status =
+ lsp_builtin_get_args_2(e->m, args, &callable, &arguments);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_builtin(e->m, callable) &&
+ !lsp_mem_is_function_or_syntax(e->m, callable))
+ return LSP_ERR_ARG_TYPE;
+
+ return lsp_apply(e, ctx, callable, arguments);
+}
+
+
+lsp_status_t lsp_function_error(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_number(e->m, value))
+ return LSP_ERR_ARG_TYPE;
+
+ lsp_int32_t code = lsp_mem_get_number(e->m, value);
+ if (code < 0 || code > 126)
+ return LSP_ERR_ARG_VALUE;
+
+ return LSP_ERR_USER + code;
+}
+
+
+lsp_status_t lsp_function_cons(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t first;
+ lsp_addr_t second;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &first, &second);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t result;
+ status = lsp_mem_create_pair(e->m, first, second, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_set_car(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t pair;
+ lsp_addr_t first;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &pair, &first);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_pair(e->m, pair))
+ return LSP_ERR_ARG_TYPE;
+
+ if (pair == e->m->nil)
+ return LSP_ERR_ARG_VALUE;
+
+ lsp_mem_set_pair_first(e->m, pair, first);
+ return lsp_env_set_result_value(e, e->m->nil);
+}
+
+
+lsp_status_t lsp_function_set_cdr(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t pair;
+ lsp_addr_t second;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &pair, &second);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_pair(e->m, pair))
+ return LSP_ERR_ARG_TYPE;
+
+ if (pair == e->m->nil)
+ return LSP_ERR_ARG_VALUE;
+
+ lsp_mem_set_pair_second(e->m, pair, second);
+ return lsp_env_set_result_value(e, e->m->nil);
+}
+
+
+lsp_status_t lsp_function_is_number(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_number = lsp_mem_is_number(e->m, value);
+ return lsp_env_set_result_value(e, (is_number ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_is_pair(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_pair = lsp_mem_is_pair(e->m, value);
+ return lsp_env_set_result_value(e, (is_pair ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_is_string(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_string = lsp_mem_is_string(e->m, value);
+ return lsp_env_set_result_value(e, (is_string ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_is_symbol(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_symbol = lsp_mem_is_symbol(e->m, value);
+ return lsp_env_set_result_value(e, (is_symbol ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_is_function(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_function = lsp_mem_is_function(e->m, value) ||
+ lsp_mem_is_builtin_function(e->m, value);
+ return lsp_env_set_result_value(e, (is_function ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_is_syntax(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_syntax = lsp_mem_is_syntax(e->m, value) ||
+ lsp_mem_is_builtin_syntax(e->m, value);
+ return lsp_env_set_result_value(e, (is_syntax ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_eq(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t first;
+ lsp_addr_t second;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &first, &second);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_eq = lsp_mem_eq(e->m, first, second);
+ return lsp_env_set_result_value(e, (is_eq ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_equal(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t first;
+ lsp_addr_t second;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &first, &second);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_equal = lsp_mem_equal(e->m, first, second);
+ return lsp_env_set_result_value(e, (is_equal ? e->m->one : e->m->zero));
+}
+
+
+lsp_status_t lsp_function_gt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t last_value = e->m->nil;
+
+ while (args != e->m->nil) {
+ lsp_addr_t value = lsp_mem_get_pair_first(e->m, args);
+ if (!lsp_mem_is_number(e->m, value))
+ return LSP_ERR_ARG_TYPE;
+
+ if (last_value != e->m->nil && lsp_mem_get_number(e->m, last_value) <=
+ lsp_mem_get_number(e->m, value))
+ return lsp_env_set_result_value(e, e->m->zero);
+
+ last_value = value;
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ return lsp_env_set_result_value(e, e->m->one);
+}
+
+
+lsp_status_t lsp_function_lt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t last_value = e->m->nil;
+
+ while (args != e->m->nil) {
+ lsp_addr_t value = lsp_mem_get_pair_first(e->m, args);
+ if (!lsp_mem_is_number(e->m, value))
+ return LSP_ERR_ARG_TYPE;
+
+ if (last_value != e->m->nil && lsp_mem_get_number(e->m, last_value) >=
+ lsp_mem_get_number(e->m, value))
+ return lsp_env_set_result_value(e, e->m->zero);
+
+ last_value = value;
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ return lsp_env_set_result_value(e, e->m->one);
+}
+
+
+lsp_status_t lsp_function_plus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_int32_t value = 0;
+
+ while (args != e->m->nil) {
+ lsp_addr_t i = lsp_mem_get_pair_first(e->m, args);
+ if (!lsp_mem_is_number(e->m, i))
+ return LSP_ERR_ARG_TYPE;
+
+ value += lsp_mem_get_number(e->m, i);
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ lsp_addr_t result;
+ lsp_status_t status = lsp_mem_create_number(e->m, value, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_minus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_int32_t value;
+ lsp_uint16_t counter = 0;
+
+ while (args != e->m->nil) {
+ lsp_addr_t i = lsp_mem_get_pair_first(e->m, args);
+ if (!lsp_mem_is_number(e->m, i))
+ return LSP_ERR_ARG_TYPE;
+
+ if (++counter > 1) {
+ value -= lsp_mem_get_number(e->m, i);
+ } else {
+ value = lsp_mem_get_number(e->m, i);
+ }
+
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ if (!counter)
+ return LSP_ERR_ARG_COUNT;
+
+ if (counter < 2)
+ value = -value;
+
+ lsp_addr_t result;
+ lsp_status_t status = lsp_mem_create_number(e->m, value, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_multiply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_int32_t value = 1;
+
+ while (args != e->m->nil) {
+ lsp_addr_t i = lsp_mem_get_pair_first(e->m, args);
+ if (!lsp_mem_is_number(e->m, i))
+ return LSP_ERR_ARG_TYPE;
+
+ value *= lsp_mem_get_number(e->m, i);
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ lsp_addr_t result;
+ lsp_status_t status = lsp_mem_create_number(e->m, value, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_divide(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_int32_t value;
+ lsp_uint16_t counter = 0;
+
+ while (args != e->m->nil) {
+ lsp_addr_t i = lsp_mem_get_pair_first(e->m, args);
+ if (!lsp_mem_is_number(e->m, i))
+ return LSP_ERR_ARG_TYPE;
+
+ if (++counter > 1) {
+ value /= lsp_mem_get_number(e->m, i);
+ } else {
+ value = lsp_mem_get_number(e->m, i);
+ }
+
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ if (!counter)
+ return LSP_ERR_ARG_COUNT;
+
+ if (counter < 2)
+ value = 1 / value;
+
+ lsp_addr_t result;
+ lsp_status_t status = lsp_mem_create_number(e->m, value, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+
+lsp_status_t lsp_function_read(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ if (args != e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_addr_t value;
+ lsp_status_t status = lsp_read(e->m, e->in, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, value);
+ lsp_mem_dec_ref(e->m, value);
+ return status;
+}
+
+
+lsp_status_t lsp_function_read_u8(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ if (args != e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_read(e->in, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t result;
+ status = lsp_mem_create_number(e->m, c, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_peek_u8(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ if (args != e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_peek(e->in, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t result;
+ status = lsp_mem_create_number(e->m, c, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_write(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_write(e->m, e->out, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_env_set_result_value(e, e->m->nil);
+}
+
+
+lsp_status_t lsp_function_write_u8(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_number(e->m, value))
+ return LSP_ERR_ARG_TYPE;
+
+ lsp_uint8_t c = lsp_mem_get_number(e->m, value);
+ status = lsp_out_stream_write(e->out, c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_env_set_result_value(e, e->m->nil);
+}
+
+
+lsp_status_t lsp_function_make_string(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_number(e->m, value))
+ return LSP_ERR_ARG_TYPE;
+
+ lsp_uint16_t str_len = lsp_mem_get_number(e->m, value);
+
+ lsp_addr_t result;
+ status = lsp_mem_create_string(e->m, str_len, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_string_length(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t str;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &str);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_string(e->m, str))
+ return LSP_ERR_ARG_TYPE;
+
+ lsp_uint16_t str_len = lsp_mem_get_string_len(e->m, str);
+
+ lsp_addr_t result;
+ status = lsp_mem_create_number(e->m, str_len, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_string_ref(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t str;
+ lsp_addr_t index;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &str, &index);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_string(e->m, str) || !lsp_mem_is_number(e->m, index))
+ return LSP_ERR_ARG_TYPE;
+
+ lsp_uint16_t i = lsp_mem_get_number(e->m, index);
+ lsp_uint16_t str_len = lsp_mem_get_string_len(e->m, str);
+ if (i >= str_len)
+ return LSP_ERR_ARG_VALUE;
+
+ lsp_uint8_t c = lsp_mem_get_string_data(e->m, str, i);
+
+ lsp_addr_t result;
+ status = lsp_mem_create_number(e->m, c, &result);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_function_string_set(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args) {
+ lsp_addr_t str;
+ lsp_addr_t index;
+ lsp_addr_t value;
+ lsp_status_t status =
+ lsp_builtin_get_args_3(e->m, args, &str, &index, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_string(e->m, str) || !lsp_mem_is_number(e->m, index) ||
+ !lsp_mem_is_number(e->m, value))
+ return LSP_ERR_ARG_TYPE;
+
+ lsp_uint16_t i = lsp_mem_get_number(e->m, index);
+ lsp_uint16_t str_len = lsp_mem_get_string_len(e->m, str);
+ if (i >= str_len)
+ return LSP_ERR_ARG_VALUE;
+
+ lsp_mem_set_string_data(e->m, str, i, lsp_mem_get_number(e->m, value));
+
+ return lsp_env_set_result_value(e, e->m->nil);
+}
diff --git a/src_c/function.h b/src_c/function.h
new file mode 100644
index 0000000..ce249c4
--- /dev/null
+++ b/src_c/function.h
@@ -0,0 +1,54 @@
+#ifndef LISP16_FUNCTION_H
+#define LISP16_FUNCTION_H
+
+#include "builtin.h"
+
+
+extern lsp_builtin_entry_t lsp_functions[];
+
+lsp_status_t lsp_function_eval(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_apply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_error(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_cons(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_set_car(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_set_cdr(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_is_number(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_is_pair(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_is_string(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_is_symbol(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_is_function(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_is_syntax(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_eq(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_equal(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_gt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_lt(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_plus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_minus(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_multiply(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_divide(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_read(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_read_u8(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_peek_u8(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_write(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_function_write_u8(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_make_string(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_string_length(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_string_ref(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+lsp_status_t lsp_function_string_set(lsp_env_t *e, lsp_addr_t ctx,
+ lsp_addr_t args);
+
+#endif
diff --git a/src_c/main.c b/src_c/main.c
new file mode 100644
index 0000000..c09a38b
--- /dev/null
+++ b/src_c/main.c
@@ -0,0 +1,55 @@
+#include "ctx.h"
+#include "repl.h"
+
+#if LSP_ARCH == LSP_ARCH_POSIX
+#include "arch/posix.h"
+#elif LSP_ARCH == LSP_ARCH_AVR8
+#include "arch/avr8.h"
+#elif LSP_ARCH == LSP_ARCH_STM32
+#include "arch/stm32.h"
+#endif
+
+
+int main() {
+ lsp_mem_t *m = NULL;
+ lsp_in_stream_t *in = NULL;
+ lsp_out_stream_t *out = NULL;
+ lsp_status_t status = LSP_ERR;
+
+ LSP_ARCH_INIT();
+
+ m = LSP_ARCH_CREATE_MEM();
+ if (!m)
+ goto cleanup;
+
+ in = LSP_ARCH_CREATE_IN_STREAM();
+ if (!in)
+ goto cleanup;
+
+ out = LSP_ARCH_CREATE_OUT_STREAM();
+ if (!out)
+ goto cleanup;
+
+ lsp_env_t e;
+ lsp_env_init(&e, m, in, out);
+
+ lsp_addr_t ctx;
+ status = lsp_ctx_create(m, &ctx);
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+
+ status = lsp_repl(&e, ctx);
+ lsp_mem_dec_ref(m, ctx);
+
+cleanup:
+ if (out)
+ LSP_ARCH_FREE_OUT_STREAM(out);
+
+ if (in)
+ LSP_ARCH_FREE_IN_STREAM(in);
+
+ if (m)
+ LSP_ARCH_FREE_MEM(m);
+
+ return ((status == LSP_EOF) ? 0 : 1);
+}
diff --git a/src_c/mem.c b/src_c/mem.c
new file mode 100644
index 0000000..31ca83d
--- /dev/null
+++ b/src_c/mem.c
@@ -0,0 +1,478 @@
+#include "mem.h"
+
+
+static inline lsp_bool_t get_mark(lsp_cell_t *c) {
+ return ((*c & 0x8000) ? true : false);
+}
+
+
+static inline void set_mark(lsp_cell_t *c, lsp_bool_t mark) {
+ if (mark) {
+ *c |= 0x8000;
+ } else {
+ *c &= 0x7fff;
+ }
+}
+
+
+static void restore(lsp_mem_t *m, lsp_addr_t addr) {
+ while (true) {
+ lsp_cell_t *c = m->cells + addr;
+ if (!get_mark(c))
+ break;
+
+ lsp_uint16_t c_size = lsp_cell_get_size(c);
+ for (lsp_uint16_t i = 0; i < c_size; ++i)
+ set_mark(c + i, false);
+
+ if (lsp_cell_is_pair(c)) {
+ restore(m, lsp_cell_get_pair_first(c));
+ addr = lsp_cell_get_pair_second(c);
+
+ } else if (lsp_cell_is_function(c)) {
+ restore(m, lsp_cell_get_function_parent_ctx(c));
+ restore(m, lsp_cell_get_function_args(c));
+ addr = lsp_cell_get_function_body(c);
+
+ } else if (lsp_cell_is_syntax(c)) {
+ restore(m, lsp_cell_get_syntax_parent_ctx(c));
+ restore(m, lsp_cell_get_syntax_args(c));
+ addr = lsp_cell_get_syntax_body(c);
+ }
+ }
+}
+
+
+static void mark_and_restore(lsp_mem_t *m) {
+ for (lsp_addr_t addr = 0; addr < m->size; ++addr)
+ set_mark(m->cells + addr, true);
+
+ restore(m, m->nil);
+ restore(m, m->zero);
+ restore(m, m->one);
+ restore(m, m->quote);
+ restore(m, m->quasiquote);
+ restore(m, m->unquote);
+ restore(m, m->unquote_splicing);
+ restore(m, m->root);
+}
+
+
+static lsp_bool_t is_free_cell(lsp_mem_t *m, lsp_addr_t addr, lsp_uint16_t size,
+ lsp_addr_t *used_addr) {
+ for (lsp_addr_t i = addr; i < addr + size; ++i) {
+ if (!get_mark(m->cells + i)) {
+ *used_addr = i;
+ return false;
+ }
+ }
+
+ return true;
+}
+
+
+static lsp_status_t find_free_cell(lsp_mem_t *m, lsp_uint16_t size,
+ lsp_addr_t *addr) {
+ if (!size)
+ return LSP_ERR_MEM;
+
+ for (lsp_addr_t i = m->last_addr; i < m->size - size; ++i) {
+ if (is_free_cell(m, i, size, &i)) {
+ *addr = i;
+ m->last_addr = i;
+ return LSP_SUCCESS;
+ }
+ }
+
+ for (lsp_addr_t i = 0; i < m->last_addr && i < m->size - size; ++i) {
+ if (is_free_cell(m, i, size, &i)) {
+ *addr = i;
+ m->last_addr = i;
+ return LSP_SUCCESS;
+ }
+ }
+
+ return LSP_ERR_MEM;
+}
+
+
+static lsp_status_t find_free_cell_with_gc(lsp_mem_t *m, lsp_uint16_t size,
+ lsp_addr_t *addr) {
+ lsp_status_t status = find_free_cell(m, size, addr);
+ if (status == LSP_SUCCESS)
+ return LSP_SUCCESS;
+
+ mark_and_restore(m);
+
+ return find_free_cell(m, size, addr);
+}
+
+
+static lsp_status_t alloc_cell(lsp_mem_t *m, lsp_uint16_t size,
+ lsp_addr_t *addr) {
+ lsp_addr_t root;
+ lsp_status_t status = find_free_cell_with_gc(m, 2, &root);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_pair(m->cells + root, m->nil, m->root);
+ m->root = root;
+
+ status = find_free_cell_with_gc(m, size, addr);
+ if (status != LSP_SUCCESS) {
+ m->root = lsp_cell_get_pair_second(m->cells + root);
+ return status;
+ }
+
+ lsp_mem_set_pair_first(m, root, *addr);
+ return LSP_SUCCESS;
+}
+
+
+static lsp_bool_t is_symbol_from_string(lsp_mem_t *m, lsp_addr_t symbol,
+ lsp_addr_t str) {
+ lsp_uint16_t str_len = lsp_cell_get_string_len(m->cells + str);
+ if (lsp_mem_get_symbol_len(m, symbol) != str_len)
+ return false;
+
+ for (lsp_uint16_t i = 0; i < str_len; ++i)
+ if (lsp_mem_get_symbol_name(m, symbol, i) !=
+ lsp_mem_get_string_data(m, str, i))
+ return false;
+
+ return true;
+}
+
+
+static lsp_bool_t is_symbol_from_char(lsp_mem_t *m, lsp_addr_t symbol,
+ char *name, lsp_uint16_t name_len) {
+ if (lsp_mem_get_symbol_len(m, symbol) != name_len)
+ return false;
+
+ for (lsp_uint16_t i = 0; i < name_len; ++i)
+ if (lsp_mem_get_symbol_name(m, symbol, i) != name[i])
+ return false;
+
+ return true;
+}
+
+
+static lsp_status_t find_symbol_from_string(lsp_mem_t *m, lsp_addr_t str,
+ lsp_addr_t *addr) {
+ for (lsp_addr_t i = 0; i < m->size; ++i) {
+ if (get_mark(m->cells + i))
+ continue;
+
+ if (lsp_cell_is_symbol(m->cells + i) &&
+ is_symbol_from_string(m, i, str)) {
+ *addr = i;
+ return LSP_SUCCESS;
+ }
+
+ i += lsp_cell_get_size(m->cells + i) - 1;
+ }
+
+ return LSP_ERR;
+}
+
+
+static lsp_status_t find_symbol_from_char(lsp_mem_t *m, char *name,
+ lsp_uint16_t name_len,
+ lsp_addr_t *addr) {
+ for (lsp_addr_t i = 0; i < m->size; ++i) {
+ if (get_mark(m->cells + i))
+ continue;
+
+ if (lsp_cell_is_symbol(m->cells + i) &&
+ is_symbol_from_char(m, i, name, name_len)) {
+ *addr = i;
+ return LSP_SUCCESS;
+ }
+
+ i += lsp_cell_get_size(m->cells + i) - 1;
+ }
+
+ return LSP_ERR;
+}
+
+
+lsp_status_t lsp_mem_init(lsp_mem_t *m, lsp_uint16_t size) {
+ m->size = size;
+ m->last_addr = 0;
+
+ for (lsp_addr_t addr = 0; addr < size; ++addr)
+ set_mark(m->cells + addr, true);
+
+ lsp_status_t status = find_free_cell(m, 2, &(m->nil));
+ if (status != LSP_SUCCESS)
+ return status;
+ lsp_cell_set_pair(m->cells + m->nil, m->nil, m->nil);
+
+ status = find_free_cell(m, lsp_cell_get_number_size(0), &(m->zero));
+ if (status != LSP_SUCCESS)
+ return status;
+ lsp_cell_set_number(m->cells + m->zero, 0);
+
+ status = find_free_cell(m, lsp_cell_get_number_size(1), &(m->one));
+ if (status != LSP_SUCCESS)
+ return status;
+ lsp_cell_set_number(m->cells + m->one, 1);
+
+ status = find_free_cell(m, lsp_cell_get_string_symbol_size(5), &(m->quote));
+ if (status != LSP_SUCCESS)
+ return status;
+ lsp_cell_set_symbol(m->cells + m->quote, 5);
+ for (lsp_uint16_t i = 0; i < 5; ++i)
+ lsp_cell_set_symbol_name(m->cells + m->quote, i, ("quote")[i]);
+
+ status = find_free_cell(m, lsp_cell_get_string_symbol_size(10),
+ &(m->quasiquote));
+ if (status != LSP_SUCCESS)
+ return status;
+ lsp_cell_set_symbol(m->cells + m->quasiquote, 10);
+ for (lsp_uint16_t i = 0; i < 10; ++i)
+ lsp_cell_set_symbol_name(m->cells + m->quasiquote, i,
+ ("quasiquote")[i]);
+
+ status =
+ find_free_cell(m, lsp_cell_get_string_symbol_size(7), &(m->unquote));
+ if (status != LSP_SUCCESS)
+ return status;
+ lsp_cell_set_symbol(m->cells + m->unquote, 7);
+ for (lsp_uint16_t i = 0; i < 7; ++i)
+ lsp_cell_set_symbol_name(m->cells + m->unquote, i, ("unquote")[i]);
+
+ status = find_free_cell(m, lsp_cell_get_string_symbol_size(16),
+ &(m->unquote_splicing));
+ if (status != LSP_SUCCESS)
+ return status;
+ lsp_cell_set_symbol(m->cells + m->unquote_splicing, 16);
+ for (lsp_uint16_t i = 0; i < 16; ++i)
+ lsp_cell_set_symbol_name(m->cells + m->unquote_splicing, i,
+ ("unquote-splicing")[i]);
+
+ m->root = m->nil;
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_inc_ref(lsp_mem_t *m, lsp_addr_t addr) {
+ if (addr == m->nil || addr == m->zero || addr == m->one || addr == m->quote)
+ return LSP_SUCCESS;
+
+ lsp_addr_t root;
+ lsp_status_t status = find_free_cell_with_gc(m, 2, &root);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_pair(m->cells + root, addr, m->root);
+ m->root = root;
+ return LSP_SUCCESS;
+}
+
+
+void lsp_mem_dec_ref(lsp_mem_t *m, lsp_addr_t addr) {
+ if (addr == m->nil || addr == m->zero || addr == m->one || addr == m->quote)
+ return;
+
+ lsp_addr_t curr_addr = m->root;
+ lsp_addr_t prev_addr = m->nil;
+ while (curr_addr != m->nil) {
+ lsp_addr_t first = lsp_cell_get_pair_first(m->cells + curr_addr);
+ lsp_addr_t second = lsp_cell_get_pair_second(m->cells + curr_addr);
+
+ if (first == addr) {
+ if (prev_addr == m->nil) {
+ m->root = second;
+
+ } else {
+ lsp_mem_set_pair_second(m, prev_addr, second);
+ }
+
+ return;
+ }
+
+ prev_addr = curr_addr;
+ curr_addr = second;
+ }
+}
+
+
+lsp_status_t lsp_mem_create_number(lsp_mem_t *m, lsp_int32_t value,
+ lsp_addr_t *addr) {
+ lsp_uint16_t size = lsp_cell_get_number_size(value);
+ lsp_status_t status = alloc_cell(m, size, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_number(m->cells + *addr, value);
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_pair(lsp_mem_t *m, lsp_addr_t first,
+ lsp_addr_t second, lsp_addr_t *addr) {
+ lsp_status_t status = alloc_cell(m, 2, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_pair(m->cells + *addr, first, second);
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_string(lsp_mem_t *m, lsp_uint16_t data_len,
+ lsp_addr_t *addr) {
+ lsp_uint16_t size = lsp_cell_get_string_symbol_size(data_len);
+ lsp_status_t status = alloc_cell(m, size, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_string(m->cells + *addr, data_len);
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_symbol_from_string(lsp_mem_t *m, lsp_addr_t str,
+ lsp_addr_t *addr) {
+ if (find_symbol_from_string(m, str, addr) == LSP_SUCCESS)
+ return lsp_mem_inc_ref(m, *addr);
+
+ lsp_uint16_t name_len = lsp_mem_get_string_len(m, str);
+ lsp_uint16_t size = lsp_cell_get_string_symbol_size(name_len);
+ lsp_status_t status = alloc_cell(m, size, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_symbol(m->cells + *addr, name_len);
+ for (lsp_uint16_t i = 0; i < name_len; ++i)
+ lsp_cell_set_symbol_name(m->cells + *addr, i,
+ lsp_mem_get_string_data(m, str, i));
+
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_symbol_from_char(lsp_mem_t *m, char *name,
+ lsp_addr_t *addr) {
+ lsp_uint16_t name_len = 0;
+ while (name[name_len])
+ name_len++;
+
+ if (find_symbol_from_char(m, name, name_len, addr) == LSP_SUCCESS)
+ return lsp_mem_inc_ref(m, *addr);
+
+ lsp_uint16_t size = lsp_cell_get_string_symbol_size(name_len);
+ lsp_status_t status = alloc_cell(m, size, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_symbol(m->cells + *addr, name_len);
+ for (lsp_uint16_t i = 0; i < name_len; ++i)
+ lsp_cell_set_symbol_name(m->cells + *addr, i, name[i]);
+
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_builtin_function(lsp_mem_t *m, lsp_uint16_t index,
+ lsp_addr_t *addr) {
+ lsp_status_t status = alloc_cell(m, 1, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_builtin_function(m->cells + *addr, index);
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_builtin_syntax(lsp_mem_t *m, lsp_uint16_t index,
+ lsp_addr_t *addr) {
+ lsp_status_t status = alloc_cell(m, 1, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_builtin_syntax(m->cells + *addr, index);
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_function(lsp_mem_t *m, lsp_addr_t parent_ctx,
+ lsp_addr_t args, lsp_addr_t body,
+ lsp_addr_t *addr) {
+ lsp_status_t status = alloc_cell(m, 4, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_function(m->cells + *addr, parent_ctx, args, body);
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_mem_create_syntax(lsp_mem_t *m, lsp_addr_t parent_ctx,
+ lsp_addr_t args, lsp_addr_t body,
+ lsp_addr_t *addr) {
+ lsp_status_t status = alloc_cell(m, 4, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_cell_set_syntax(m->cells + *addr, parent_ctx, args, body);
+ return LSP_SUCCESS;
+}
+
+
+lsp_bool_t lsp_mem_eq(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2) {
+ if (a1 == a2)
+ return true;
+
+ if (lsp_mem_is_number(m, a1)) {
+ if (!lsp_mem_is_number(m, a2))
+ return false;
+
+ return lsp_mem_get_number(m, a1) == lsp_mem_get_number(m, a2);
+ }
+
+ return false;
+}
+
+
+lsp_bool_t lsp_mem_equal(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2) {
+ if (lsp_mem_eq(m, a1, a2))
+ return true;
+
+ if (lsp_mem_is_pair(m, a1)) {
+ if (!lsp_mem_is_pair(m, a2))
+ return false;
+
+ while (a1 != m->nil && a2 != m->nil) {
+ if (!lsp_mem_equal(m, lsp_mem_get_pair_first(m, a1),
+ lsp_mem_get_pair_first(m, a2)))
+ return false;
+
+ a1 = lsp_mem_get_pair_second(m, a1);
+ a2 = lsp_mem_get_pair_second(m, a2);
+ }
+
+ return a1 == a2;
+ }
+
+ if (lsp_mem_is_string(m, a1)) {
+ if (!lsp_mem_is_string(m, a2))
+ return false;
+
+ lsp_uint16_t a1_len = lsp_mem_get_string_len(m, a1);
+ lsp_uint16_t a2_len = lsp_mem_get_string_len(m, a2);
+ if (a1_len != a2_len)
+ return false;
+
+ for (lsp_uint16_t i = 0; i < a1_len; ++i) {
+ if (lsp_mem_get_string_data(m, a1, i) !=
+ lsp_mem_get_string_data(m, a2, i))
+ return false;
+ }
+
+ return true;
+ }
+
+ return false;
+}
diff --git a/src_c/mem.h b/src_c/mem.h
new file mode 100644
index 0000000..7d72ba9
--- /dev/null
+++ b/src_c/mem.h
@@ -0,0 +1,189 @@
+#ifndef LISP16_MEM_H
+#define LISP16_MEM_H
+
+#include "cell.h"
+#include "status.h"
+
+
+typedef struct {
+ lsp_addr_t nil;
+ lsp_addr_t zero;
+ lsp_addr_t one;
+ lsp_addr_t quote;
+ lsp_addr_t quasiquote;
+ lsp_addr_t unquote;
+ lsp_addr_t unquote_splicing;
+
+ // internal
+ lsp_uint16_t size;
+ lsp_addr_t last_addr;
+ lsp_addr_t root;
+ lsp_cell_t cells[];
+} lsp_mem_t;
+
+
+lsp_status_t lsp_mem_init(lsp_mem_t *m, lsp_uint16_t size);
+lsp_status_t lsp_mem_inc_ref(lsp_mem_t *m, lsp_addr_t addr);
+void lsp_mem_dec_ref(lsp_mem_t *m, lsp_addr_t addr);
+
+lsp_status_t lsp_mem_create_number(lsp_mem_t *m, lsp_int32_t value,
+ lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_pair(lsp_mem_t *m, lsp_addr_t first,
+ lsp_addr_t second, lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_string(lsp_mem_t *m, lsp_uint16_t data_len,
+ lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_symbol_from_string(lsp_mem_t *m, lsp_addr_t str,
+ lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_symbol_from_char(lsp_mem_t *m, char *name,
+ lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_builtin_function(lsp_mem_t *m, lsp_uint16_t index,
+ lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_builtin_syntax(lsp_mem_t *m, lsp_uint16_t index,
+ lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_function(lsp_mem_t *m, lsp_addr_t parent_ctx,
+ lsp_addr_t args, lsp_addr_t body,
+ lsp_addr_t *addr);
+lsp_status_t lsp_mem_create_syntax(lsp_mem_t *m, lsp_addr_t parent_ctx,
+ lsp_addr_t args, lsp_addr_t body,
+ lsp_addr_t *addr);
+
+lsp_bool_t lsp_mem_eq(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2);
+lsp_bool_t lsp_mem_equal(lsp_mem_t *m, lsp_addr_t a1, lsp_addr_t a2);
+
+
+static inline lsp_bool_t lsp_mem_is_number(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_is_number(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_pair(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_is_pair(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_string(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_is_string(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_symbol(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_is_symbol(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_builtin_function(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_is_builtin_function(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_builtin_syntax(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_is_builtin_syntax(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_function(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_is_function(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_syntax(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_is_syntax(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_string_or_symbol(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_is_string_or_symbol(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_builtin(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_is_builtin(m->cells + addr);
+}
+
+static inline lsp_bool_t lsp_mem_is_function_or_syntax(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_is_function_or_syntax(m->cells + addr);
+}
+
+
+static inline lsp_int32_t lsp_mem_get_number(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_get_number(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_pair_first(lsp_mem_t *m, lsp_addr_t addr) {
+ return lsp_cell_get_pair_first(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_pair_second(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_pair_second(m->cells + addr);
+}
+
+static inline lsp_uint16_t lsp_mem_get_string_len(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_string_len(m->cells + addr);
+}
+
+static inline lsp_uint8_t lsp_mem_get_string_data(lsp_mem_t *m, lsp_addr_t addr,
+ lsp_uint16_t i) {
+ return lsp_cell_get_string_data(m->cells + addr, i);
+}
+
+static inline lsp_uint16_t lsp_mem_get_symbol_len(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_symbol_len(m->cells + addr);
+}
+
+static inline lsp_uint8_t lsp_mem_get_symbol_name(lsp_mem_t *m, lsp_addr_t addr,
+ lsp_uint16_t i) {
+ return lsp_cell_get_symbol_name(m->cells + addr, i);
+}
+
+static inline lsp_uint16_t lsp_mem_get_builtin_index(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_builtin_index(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_function_parent_ctx(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_function_parent_ctx(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_function_args(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_function_args(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_function_body(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_function_body(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_syntax_parent_ctx(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_syntax_parent_ctx(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_syntax_args(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_syntax_args(m->cells + addr);
+}
+
+static inline lsp_addr_t lsp_mem_get_syntax_body(lsp_mem_t *m,
+ lsp_addr_t addr) {
+ return lsp_cell_get_syntax_body(m->cells + addr);
+}
+
+
+static inline void lsp_mem_set_pair_first(lsp_mem_t *m, lsp_addr_t addr,
+ lsp_addr_t first) {
+ lsp_cell_set_pair(m->cells + addr, first,
+ lsp_cell_get_pair_second(m->cells + addr));
+}
+
+static inline void lsp_mem_set_pair_second(lsp_mem_t *m, lsp_addr_t addr,
+ lsp_addr_t second) {
+ lsp_cell_set_pair(m->cells + addr, lsp_cell_get_pair_first(m->cells + addr),
+ second);
+}
+
+static inline void lsp_mem_set_string_data(lsp_mem_t *m, lsp_addr_t addr,
+ lsp_uint16_t i, lsp_uint8_t data_i) {
+ lsp_cell_set_string_data(m->cells + addr, i, data_i);
+}
+
+#endif
diff --git a/src_c/read.c b/src_c/read.c
new file mode 100644
index 0000000..82250f5
--- /dev/null
+++ b/src_c/read.c
@@ -0,0 +1,428 @@
+#include "read.h"
+#include "buff.h"
+
+
+static inline lsp_bool_t is_ws(lsp_uint8_t v) {
+ return (v == ' ') || (v == '\n') || (v == '\r') || (v == '\t');
+}
+
+
+static inline lsp_bool_t is_comment_start(lsp_uint8_t v) { return v == ';'; }
+
+
+static inline lsp_bool_t is_comment_stop(lsp_uint8_t v) { return v == '\n'; }
+
+
+static inline lsp_bool_t is_digit(lsp_uint8_t v) {
+ return (v >= '0') && (v <= '9');
+}
+
+
+static inline lsp_bool_t is_list_start(lsp_uint8_t v) {
+ return (v == '(') || (v == '[') || (v == '{');
+}
+
+
+static inline lsp_bool_t is_list_stop(lsp_uint8_t v) {
+ return (v == ')') || (v == ']') || (v == '}');
+}
+
+
+static inline lsp_bool_t is_str_start_stop(lsp_uint8_t v) { return v == '"'; }
+
+
+static inline lsp_bool_t is_quote(lsp_uint8_t v) { return v == '\''; }
+
+
+static inline lsp_bool_t is_quasiquote(lsp_uint8_t v) { return v == '`'; }
+
+
+static inline lsp_bool_t is_unquote(lsp_uint8_t v) { return v == ','; }
+
+
+static lsp_status_t skip_ws(lsp_in_stream_t *s) {
+ while (true) {
+ lsp_uint8_t v;
+ lsp_status_t status = lsp_in_stream_peek(s, &v);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (is_comment_start(v)) {
+ while (!is_comment_stop(v)) {
+ status = lsp_in_stream_read(s, &v);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ continue;
+ }
+
+ if (!is_ws(v))
+ return LSP_SUCCESS;
+
+ lsp_in_stream_read(s, &v);
+ }
+}
+
+
+static lsp_status_t read_number(lsp_mem_t *m, lsp_in_stream_t *s,
+ lsp_addr_t *addr) {
+ lsp_int32_t v = 0;
+
+ while (true) {
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_peek(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (is_ws(c) || is_list_start(c) || is_list_stop(c))
+ break;
+
+ if (!is_digit(c))
+ return LSP_ERR_READ;
+
+ status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ v = (v * 10) + (c - '0');
+ }
+
+ if (v == 0) {
+ *addr = m->zero;
+ return LSP_SUCCESS;
+ }
+
+ if (v == 1) {
+ *addr = m->one;
+ return LSP_SUCCESS;
+ }
+
+ return lsp_mem_create_number(m, v, addr);
+}
+
+
+static lsp_status_t read_list(lsp_mem_t *m, lsp_in_stream_t *s,
+ lsp_addr_t *addr) {
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_uint8_t list_end;
+ if (c == '(') {
+ list_end = ')';
+ } else if (c == '[') {
+ list_end = ']';
+ } else if (c == '{') {
+ list_end = '}';
+ } else {
+ return LSP_ERR_READ;
+ }
+
+ lsp_bool_t read_rest = false;
+ lsp_bool_t read_stop = false;
+ lsp_addr_t rest = m->nil;
+ lsp_addr_t last = m->nil;
+ *addr = m->nil;
+
+ while (true) {
+ status = skip_ws(s);
+ if (status != LSP_SUCCESS)
+ break;
+
+ status = lsp_in_stream_peek(s, &c);
+ if (status != LSP_SUCCESS)
+ break;
+
+ if (is_list_stop(c)) {
+ status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ break;
+
+ if (c != list_end) {
+ status = LSP_ERR_READ;
+ break;
+ }
+
+ lsp_mem_set_pair_second(m, last, rest);
+ lsp_mem_dec_ref(m, rest);
+ return LSP_SUCCESS;
+ }
+
+ if (read_stop) {
+ status = LSP_ERR_READ;
+ break;
+ }
+
+ lsp_addr_t el;
+ status = lsp_read(m, s, &el);
+ if (status != LSP_SUCCESS)
+ break;
+
+ if (lsp_mem_is_symbol(m, el) && lsp_mem_get_symbol_len(m, el) == 1 &&
+ lsp_mem_get_symbol_name(m, el, 0) == '.') {
+ lsp_mem_dec_ref(m, el);
+
+ if (read_rest) {
+ status = LSP_ERR_READ;
+ break;
+ }
+
+ read_rest = true;
+ continue;
+ }
+
+ if (read_rest) {
+ rest = el;
+ read_stop = true;
+ continue;
+ }
+
+ lsp_addr_t new_last;
+ status = lsp_mem_create_pair(m, el, m->nil, &new_last);
+ lsp_mem_dec_ref(m, el);
+ if (status != LSP_SUCCESS)
+ break;
+
+ lsp_mem_set_pair_second(m, last, new_last);
+ last = new_last;
+
+ if (*addr == m->nil) {
+ *addr = last;
+ } else {
+ lsp_mem_dec_ref(m, last);
+ }
+ }
+
+ lsp_mem_dec_ref(m, *addr);
+ lsp_mem_dec_ref(m, rest);
+ return status;
+}
+
+
+static lsp_status_t read_string(lsp_mem_t *m, lsp_in_stream_t *s,
+ lsp_addr_t *addr) {
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!is_str_start_stop(c))
+ return LSP_ERR_READ;
+
+ lsp_buff_t buff;
+ lsp_buff_init(&buff, m);
+
+ lsp_bool_t read_escaped = false;
+
+ while (true) {
+ status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+
+ if (read_escaped) {
+ if (c == 'n') {
+ status = lsp_buff_push(&buff, '\n');
+ } else if (c == 'r') {
+ status = lsp_buff_push(&buff, '\r');
+ } else if (c == 't') {
+ status = lsp_buff_push(&buff, '\t');
+ } else if (c == '\\') {
+ status = lsp_buff_push(&buff, '\\');
+ } else if (c == '"') {
+ status = lsp_buff_push(&buff, '"');
+ } else {
+ status = LSP_ERR_READ;
+ }
+
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+
+ read_escaped = false;
+ continue;
+ }
+
+ if (c == '\\') {
+ read_escaped = true;
+ continue;
+ }
+
+ if (is_str_start_stop(c))
+ break;
+
+ status = lsp_buff_push(&buff, c);
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+ }
+
+ status = lsp_buff_pop(&buff, addr);
+
+cleanup:
+ lsp_buff_clear(&buff);
+ return status;
+}
+
+
+static lsp_status_t read_quote(lsp_mem_t *m, lsp_in_stream_t *s,
+ lsp_addr_t *addr) {
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!is_quote(c))
+ return LSP_ERR_READ;
+
+ lsp_addr_t value;
+ status = lsp_read(m, s, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t list;
+ status = lsp_mem_create_pair(m, value, m->nil, &list);
+ lsp_mem_dec_ref(m, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_mem_create_pair(m, m->quote, list, addr);
+ lsp_mem_dec_ref(m, list);
+ return status;
+}
+
+
+static lsp_status_t read_quasiquote(lsp_mem_t *m, lsp_in_stream_t *s,
+ lsp_addr_t *addr) {
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!is_quasiquote(c))
+ return LSP_ERR_READ;
+
+ lsp_addr_t value;
+ status = lsp_read(m, s, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t list;
+ status = lsp_mem_create_pair(m, value, m->nil, &list);
+ lsp_mem_dec_ref(m, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_mem_create_pair(m, m->quasiquote, list, addr);
+ lsp_mem_dec_ref(m, list);
+ return status;
+}
+
+
+static lsp_status_t read_unquote(lsp_mem_t *m, lsp_in_stream_t *s,
+ lsp_addr_t *addr) {
+ lsp_uint8_t c;
+ lsp_status_t status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!is_unquote(c))
+ return LSP_ERR_READ;
+
+ status = lsp_in_stream_peek(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_splicing = (c == '@');
+ if (is_splicing) {
+ status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ lsp_addr_t value;
+ status = lsp_read(m, s, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t list;
+ status = lsp_mem_create_pair(m, value, m->nil, &list);
+ lsp_mem_dec_ref(m, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_mem_create_pair(
+ m, (is_splicing ? m->unquote_splicing : m->unquote), list, addr);
+ lsp_mem_dec_ref(m, list);
+ return status;
+}
+
+
+static lsp_status_t read_symbol(lsp_mem_t *m, lsp_in_stream_t *s,
+ lsp_addr_t *addr) {
+ lsp_status_t status;
+
+ lsp_buff_t buff;
+ lsp_buff_init(&buff, m);
+
+ while (true) {
+ lsp_uint8_t c;
+ status = lsp_in_stream_peek(s, &c);
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+
+ if (is_ws(c) || is_list_start(c) || is_list_stop(c))
+ break;
+
+ status = lsp_in_stream_read(s, &c);
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+
+ status = lsp_buff_push(&buff, c);
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+ }
+
+ lsp_addr_t str;
+ status = lsp_buff_pop(&buff, &str);
+ if (status != LSP_SUCCESS)
+ goto cleanup;
+
+ status = lsp_mem_create_symbol_from_string(m, str, addr);
+ lsp_mem_dec_ref(m, str);
+
+cleanup:
+ lsp_buff_clear(&buff);
+ return status;
+}
+
+
+lsp_status_t lsp_read(lsp_mem_t *m, lsp_in_stream_t *s, lsp_addr_t *addr) {
+ lsp_status_t status = skip_ws(s);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_uint8_t c;
+ status = lsp_in_stream_peek(s, &c);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (is_list_start(c))
+ return read_list(m, s, addr);
+
+ if (is_str_start_stop(c))
+ return read_string(m, s, addr);
+
+ if (is_digit(c))
+ return read_number(m, s, addr);
+
+ if (is_quote(c))
+ return read_quote(m, s, addr);
+
+ if (is_quasiquote(c))
+ return read_quasiquote(m, s, addr);
+
+ if (is_unquote(c))
+ return read_unquote(m, s, addr);
+
+ return read_symbol(m, s, addr);
+}
diff --git a/src_c/read.h b/src_c/read.h
new file mode 100644
index 0000000..15bfb7d
--- /dev/null
+++ b/src_c/read.h
@@ -0,0 +1,10 @@
+#ifndef LISP16_READ_H
+#define LISP16_READ_H
+
+#include "mem.h"
+#include "stream.h"
+
+
+lsp_status_t lsp_read(lsp_mem_t *m, lsp_in_stream_t *s, lsp_addr_t *addr);
+
+#endif
diff --git a/src_c/repl.c b/src_c/repl.c
new file mode 100644
index 0000000..6563613
--- /dev/null
+++ b/src_c/repl.c
@@ -0,0 +1,104 @@
+#include "repl.h"
+#include "ctx.h"
+#include "write.h"
+#include "read.h"
+#include "eval.h"
+
+
+static void log_status(lsp_out_stream_t *s, lsp_status_t status) {
+ if (status == LSP_SUCCESS)
+ return;
+
+ lsp_out_stream_write_str(s, "error: ");
+
+ if (status == LSP_ERR_MEM) {
+ lsp_out_stream_write_str(s, "no memory");
+
+ } else if (status == LSP_ERR_CTX) {
+ lsp_out_stream_write_str(s, "can't resolve symbol");
+
+ } else if (status == LSP_ERR_READ) {
+ lsp_out_stream_write_str(s, "reader error");
+
+ } else if (status == LSP_ERR_WRITE) {
+ lsp_out_stream_write_str(s, "writer error");
+
+ } else if (status == LSP_ERR_EVAL) {
+ lsp_out_stream_write_str(s, "evaluation error");
+
+ } else if (status == LSP_ERR_APPLY) {
+ lsp_out_stream_write_str(s, "application error");
+
+ } else if (status == LSP_ERR_ARG_COUNT) {
+ lsp_out_stream_write_str(s, "invalid argument count");
+
+ } else if (status == LSP_ERR_ARG_TYPE) {
+ lsp_out_stream_write_str(s, "invalid argument type");
+
+ } else if (status == LSP_ERR_ARG_VALUE) {
+ lsp_out_stream_write_str(s, "invalid argument value");
+
+ } else if (status >= LSP_ERR_USER) {
+ lsp_out_stream_write_str(s, "user error ");
+ lsp_out_stream_write_int(s, status - LSP_ERR_USER);
+
+ } else {
+ lsp_out_stream_write_str(s, "other error");
+ }
+
+ lsp_out_stream_write(s, '\n');
+}
+
+
+static lsp_status_t skip_line(lsp_in_stream_t *s) {
+ lsp_uint8_t c;
+ lsp_status_t status;
+
+ do {
+ status = lsp_in_stream_read(s, &c);
+ } while (status == LSP_SUCCESS && c != '\n');
+
+ return status;
+}
+
+
+lsp_status_t lsp_repl(lsp_env_t *e, lsp_addr_t ctx) {
+ while (true) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_read(e->m, e->in, &value);
+ if (status == LSP_EOF)
+ return status;
+ if (status != LSP_SUCCESS) {
+ log_status(e->out, status);
+
+ status = skip_line(e->in);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ continue;
+ }
+
+ lsp_addr_t result;
+ status = lsp_env_resolve(e, ctx, value, &result);
+ lsp_mem_dec_ref(e->m, value);
+ if (status == LSP_EOF)
+ return status;
+ if (status != LSP_SUCCESS) {
+ log_status(e->out, status);
+ continue;
+ }
+
+ if (result == e->m->nil)
+ continue;
+
+ status = lsp_write(e->m, e->out, result);
+ lsp_mem_dec_ref(e->m, result);
+ if (status == LSP_EOF)
+ return status;
+ if (status != LSP_SUCCESS) {
+ log_status(e->out, status);
+ continue;
+ }
+ lsp_out_stream_write(e->out, '\n');
+ }
+}
diff --git a/src_c/repl.h b/src_c/repl.h
new file mode 100644
index 0000000..9c34070
--- /dev/null
+++ b/src_c/repl.h
@@ -0,0 +1,9 @@
+#ifndef LISP16_REPL_H
+#define LISP16_REPL_H
+
+#include "env.h"
+
+
+lsp_status_t lsp_repl(lsp_env_t *e, lsp_addr_t ctx);
+
+#endif
diff --git a/src_c/status.h b/src_c/status.h
new file mode 100644
index 0000000..c6332e9
--- /dev/null
+++ b/src_c/status.h
@@ -0,0 +1,25 @@
+#ifndef LSP_STATUS_H
+#define LSP_STATUS_H
+
+#include "arch.h"
+
+#define LSP_STATUS(x) ((lsp_status_t)x)
+
+#define LSP_SUCCESS LSP_STATUS(0)
+#define LSP_EOF LSP_STATUS(-1)
+#define LSP_ERR LSP_STATUS(1)
+#define LSP_ERR_MEM LSP_STATUS(2)
+#define LSP_ERR_CTX LSP_STATUS(3)
+#define LSP_ERR_READ LSP_STATUS(4)
+#define LSP_ERR_WRITE LSP_STATUS(5)
+#define LSP_ERR_EVAL LSP_STATUS(6)
+#define LSP_ERR_APPLY LSP_STATUS(7)
+#define LSP_ERR_ARG_COUNT LSP_STATUS(8)
+#define LSP_ERR_ARG_TYPE LSP_STATUS(9)
+#define LSP_ERR_ARG_VALUE LSP_STATUS(10)
+#define LSP_ERR_USER LSP_STATUS(0x80)
+
+
+typedef lsp_int8_t lsp_status_t;
+
+#endif
diff --git a/src_c/stream.c b/src_c/stream.c
new file mode 100644
index 0000000..37f5d3d
--- /dev/null
+++ b/src_c/stream.c
@@ -0,0 +1,108 @@
+#include "stream.h"
+
+
+static lsp_int16_t str_getchar(lsp_in_stream_t *s) {
+ lsp_str_stream_t *ss = (lsp_str_stream_t *)s;
+
+ if (ss->pos >= lsp_mem_get_string_len(ss->m, ss->str))
+ return LSP_EOF;
+
+ return lsp_mem_get_string_data(ss->m, ss->str, ss->pos++);
+}
+
+
+void lsp_in_stream_init(lsp_in_stream_t *s, lsp_stream_getchar_t getchar) {
+ s->getchar = getchar;
+ s->next_available = false;
+}
+
+
+lsp_status_t lsp_in_stream_read(lsp_in_stream_t *s, lsp_uint8_t *v) {
+ if (s->next_available) {
+ s->next_available = false;
+ *v = s->next_value;
+ return s->next_status;
+ }
+
+ lsp_int16_t c = s->getchar(s);
+ *v = c;
+ return ((c == LSP_EOF) ? LSP_EOF : LSP_SUCCESS);
+}
+
+
+lsp_status_t lsp_in_stream_peek(lsp_in_stream_t *s, lsp_uint8_t *v) {
+ if (s->next_available) {
+ *v = s->next_value;
+ return s->next_status;
+ }
+
+ lsp_int16_t c = s->getchar(s);
+ s->next_available = true;
+ s->next_value = c;
+ s->next_status = ((c == LSP_EOF) ? LSP_EOF : LSP_SUCCESS);
+
+ *v = s->next_value;
+ return s->next_status;
+}
+
+
+void lsp_out_stream_init(lsp_out_stream_t *s, lsp_stream_putchar_t putchar) {
+ s->putchar = putchar;
+}
+
+
+lsp_status_t lsp_out_stream_write(lsp_out_stream_t *s, lsp_uint8_t v) {
+ if (s->putchar(s, v) == LSP_EOF)
+ return LSP_EOF;
+
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_out_stream_write_str(lsp_out_stream_t *s, char *str) {
+ while (*str) {
+ lsp_status_t status = lsp_out_stream_write(s, *(str++));
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ return LSP_SUCCESS;
+}
+
+
+lsp_status_t lsp_out_stream_write_int(lsp_out_stream_t *s, lsp_int32_t v) {
+ lsp_status_t status;
+ if (v < 0) {
+ v *= -1;
+ status = lsp_out_stream_write(s, '-');
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ lsp_uint8_t size = 0;
+ for (lsp_int32_t i = v; i; i /= 10)
+ size++;
+ if (size < 1)
+ size = 1;
+
+ for (lsp_uint8_t i = 0; i < size; ++i) {
+ lsp_int32_t temp = v;
+ for (lsp_uint8_t j = i; j < size - 1; ++j)
+ temp /= 10;
+
+ lsp_uint8_t digit = temp % 10;
+ status = lsp_out_stream_write(s, '0' + digit);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ return LSP_SUCCESS;
+}
+
+
+void lsp_str_stream_init(lsp_str_stream_t *s, lsp_mem_t *m, lsp_addr_t str) {
+ lsp_in_stream_init((lsp_in_stream_t *)s, str_getchar);
+ s->m = m;
+ s->str = str;
+ s->pos = 0;
+}
diff --git a/src_c/stream.h b/src_c/stream.h
new file mode 100644
index 0000000..268f69b
--- /dev/null
+++ b/src_c/stream.h
@@ -0,0 +1,46 @@
+#ifndef LISP16_STREAM_H
+#define LISP16_STREAM_H
+
+#include "mem.h"
+
+
+typedef struct lsp_in_stream_t lsp_in_stream_t;
+typedef struct lsp_out_stream_t lsp_out_stream_t;
+typedef lsp_int16_t (*lsp_stream_getchar_t)(lsp_in_stream_t *s);
+typedef lsp_int16_t (*lsp_stream_putchar_t)(lsp_out_stream_t *s, lsp_int16_t v);
+
+struct lsp_in_stream_t {
+ // internal
+ lsp_stream_getchar_t getchar;
+ lsp_bool_t next_available;
+ lsp_uint8_t next_value;
+ lsp_status_t next_status;
+};
+
+struct lsp_out_stream_t {
+ // internal
+ lsp_stream_putchar_t putchar;
+};
+
+typedef struct {
+ lsp_in_stream_t base;
+
+ // internal
+ lsp_mem_t *m;
+ lsp_addr_t str;
+ lsp_uint16_t pos;
+} lsp_str_stream_t;
+
+
+void lsp_in_stream_init(lsp_in_stream_t *s, lsp_stream_getchar_t getchar);
+lsp_status_t lsp_in_stream_read(lsp_in_stream_t *s, lsp_uint8_t *v);
+lsp_status_t lsp_in_stream_peek(lsp_in_stream_t *s, lsp_uint8_t *v);
+
+void lsp_out_stream_init(lsp_out_stream_t *s, lsp_stream_putchar_t putchar);
+lsp_status_t lsp_out_stream_write(lsp_out_stream_t *s, lsp_uint8_t v);
+lsp_status_t lsp_out_stream_write_str(lsp_out_stream_t *s, char *str);
+lsp_status_t lsp_out_stream_write_int(lsp_out_stream_t *s, lsp_int32_t v);
+
+void lsp_str_stream_init(lsp_str_stream_t *s, lsp_mem_t *m, lsp_addr_t str);
+
+#endif
diff --git a/src_c/syntax.c b/src_c/syntax.c
new file mode 100644
index 0000000..5ec6c7e
--- /dev/null
+++ b/src_c/syntax.c
@@ -0,0 +1,192 @@
+#include "syntax.h"
+#include "ctx.h"
+#include "eval.h"
+
+
+lsp_builtin_entry_t lsp_syntaxes[] = {
+ {"lambda", lsp_syntax_lambda}, {"syntax", lsp_syntax_syntax},
+ {"define", lsp_syntax_define}, {"set!", lsp_syntax_set},
+ {"begin", lsp_syntax_begin}, {"quote", lsp_syntax_quote},
+ {"if", lsp_syntax_if}, {NULL, NULL}};
+
+
+lsp_status_t lsp_syntax_lambda(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ if (args == e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_addr_t fn_args = lsp_mem_get_pair_first(e->m, args);
+ lsp_addr_t fn_body = lsp_mem_get_pair_second(e->m, args);
+
+ if (!lsp_mem_is_symbol(e->m, fn_args) && !lsp_mem_is_pair(e->m, fn_args))
+ return LSP_ERR_ARG_TYPE;
+
+ if (fn_body == e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_addr_t ctx_copy;
+ lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t result;
+ status = lsp_mem_create_function(e->m, ctx_copy, fn_args, fn_body, &result);
+ lsp_mem_dec_ref(e->m, ctx_copy);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_syntax_syntax(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ if (args == e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_addr_t syntax_args = lsp_mem_get_pair_first(e->m, args);
+ lsp_addr_t syntax_body = lsp_mem_get_pair_second(e->m, args);
+
+ if (!lsp_mem_is_symbol(e->m, syntax_args) &&
+ !lsp_mem_is_pair(e->m, syntax_args))
+ return LSP_ERR_ARG_TYPE;
+
+ if (syntax_body == e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_addr_t ctx_copy;
+ lsp_status_t status = lsp_ctx_copy(e->m, ctx, &ctx_copy);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_addr_t result;
+ status = lsp_mem_create_syntax(e->m, ctx_copy, syntax_args, syntax_body,
+ &result);
+ lsp_mem_dec_ref(e->m, ctx_copy);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_env_set_result_value(e, result);
+ lsp_mem_dec_ref(e->m, result);
+ return status;
+}
+
+
+lsp_status_t lsp_syntax_define(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t symbol;
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_symbol(e->m, symbol))
+ return LSP_ERR_ARG_TYPE;
+
+ status = lsp_env_resolve(e, ctx, value, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_ctx_add(e->m, ctx, symbol, value);
+ lsp_mem_dec_ref(e->m, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_env_set_result_value(e, e->m->nil);
+}
+
+
+lsp_status_t lsp_syntax_set(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t symbol;
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_2(e->m, args, &symbol, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_symbol(e->m, symbol))
+ return LSP_ERR_ARG_TYPE;
+
+ status = lsp_env_resolve(e, ctx, value, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_ctx_set(e->m, ctx, symbol, value);
+ lsp_mem_dec_ref(e->m, value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_env_set_result_value(e, e->m->nil);
+}
+
+
+lsp_status_t lsp_syntax_begin(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ if (args == e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ while (true) {
+ lsp_addr_t value = lsp_mem_get_pair_first(e->m, args);
+ lsp_addr_t next_args = lsp_mem_get_pair_second(e->m, args);
+
+ if (next_args == e->m->nil)
+ return lsp_env_set_result_eval(e, ctx, value);
+
+ lsp_status_t status = lsp_env_resolve(e, ctx, value, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_mem_dec_ref(e->m, value);
+ args = next_args;
+ }
+}
+
+
+lsp_status_t lsp_syntax_quote(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ lsp_addr_t value;
+ lsp_status_t status = lsp_builtin_get_args_1(e->m, args, &value);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_env_set_result_value(e, value);
+}
+
+
+lsp_status_t lsp_syntax_if(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args) {
+ if (args == e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_addr_t test = lsp_mem_get_pair_first(e->m, args);
+
+ args = lsp_mem_get_pair_second(e->m, args);
+ if (args == e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_addr_t true_value = lsp_mem_get_pair_first(e->m, args);
+
+ lsp_addr_t false_value;
+ args = lsp_mem_get_pair_second(e->m, args);
+ if (args == e->m->nil) {
+ false_value = e->m->nil;
+
+ } else {
+ false_value = lsp_mem_get_pair_first(e->m, args);
+ args = lsp_mem_get_pair_second(e->m, args);
+ }
+
+ if (args != e->m->nil)
+ return LSP_ERR_ARG_COUNT;
+
+ lsp_status_t status = lsp_env_resolve(e, ctx, test, &test);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t is_false = (lsp_mem_is_number(e->m, test) &&
+ lsp_mem_get_number(e->m, test) == 0) ||
+ (lsp_mem_is_pair(e->m, test) && test == e->m->nil) ||
+ (lsp_mem_is_string(e->m, test) &&
+ lsp_mem_get_string_len(e->m, test) == 0) ||
+ (lsp_mem_is_symbol(e->m, test) &&
+ lsp_mem_get_symbol_len(e->m, test) == 0);
+ lsp_mem_dec_ref(e->m, test);
+
+ return lsp_env_set_result_eval(e, ctx,
+ (is_false ? false_value : true_value));
+}
diff --git a/src_c/syntax.h b/src_c/syntax.h
new file mode 100644
index 0000000..55a6516
--- /dev/null
+++ b/src_c/syntax.h
@@ -0,0 +1,17 @@
+#ifndef LISP16_SYNTAX_H
+#define LISP16_SYNTAX_H
+
+#include "builtin.h"
+
+
+extern lsp_builtin_entry_t lsp_syntaxes[];
+
+lsp_status_t lsp_syntax_lambda(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_syntax_syntax(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_syntax_define(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_syntax_set(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_syntax_begin(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_syntax_quote(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+lsp_status_t lsp_syntax_if(lsp_env_t *e, lsp_addr_t ctx, lsp_addr_t args);
+
+#endif
diff --git a/src_c/write.c b/src_c/write.c
new file mode 100644
index 0000000..2b18aeb
--- /dev/null
+++ b/src_c/write.c
@@ -0,0 +1,174 @@
+#include "write.h"
+#include "function.h"
+#include "syntax.h"
+
+
+static lsp_status_t write_number(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ return lsp_out_stream_write_int(s, lsp_mem_get_number(m, addr));
+}
+
+
+static lsp_status_t write_pair(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ lsp_status_t status = lsp_out_stream_write(s, '(');
+ if (status != LSP_SUCCESS)
+ return status;
+
+ lsp_bool_t write_space = false;
+ while (addr != m->nil) {
+ if (write_space) {
+ lsp_out_stream_write(s, ' ');
+ } else {
+ write_space = true;
+ }
+
+ lsp_addr_t first = lsp_mem_get_pair_first(m, addr);
+ lsp_addr_t second = lsp_mem_get_pair_second(m, addr);
+
+ status = lsp_write(m, s, first);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ if (!lsp_mem_is_pair(m, second)) {
+ status = lsp_out_stream_write_str(s, " . ");
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_write(m, s, second);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ break;
+ }
+
+ addr = second;
+ }
+
+ return lsp_out_stream_write(s, ')');
+}
+
+
+static lsp_status_t write_string(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ lsp_uint16_t len = lsp_mem_get_string_len(m, addr);
+ lsp_status_t status = lsp_out_stream_write(s, '"');
+
+ for (lsp_uint16_t i = 0; i < len; ++i) {
+ lsp_uint8_t c = lsp_mem_get_string_data(m, addr, i);
+
+ if (c == '"') {
+ status = lsp_out_stream_write(s, '\\');
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ status = lsp_out_stream_write(s, c);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ return lsp_out_stream_write(s, '"');
+}
+
+
+static lsp_status_t write_symbol(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ lsp_uint16_t len = lsp_mem_get_symbol_len(m, addr);
+
+ for (lsp_uint16_t i = 0; i < len; ++i) {
+ lsp_uint8_t c = lsp_mem_get_symbol_name(m, addr, i);
+ lsp_status_t status = lsp_out_stream_write(s, c);
+ if (status != LSP_SUCCESS)
+ return status;
+ }
+
+ return LSP_SUCCESS;
+}
+
+
+static lsp_status_t write_builtin_function(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ lsp_status_t status = lsp_out_stream_write_str(s, "#<builtin-function-");
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_out_stream_write_str(
+ s, lsp_functions[lsp_mem_get_builtin_index(m, addr)].name);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_out_stream_write(s, '>');
+}
+
+
+static lsp_status_t write_builtin_syntax(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ lsp_status_t status = lsp_out_stream_write_str(s, "#<builtin-syntax-");
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_out_stream_write_str(
+ s, lsp_syntaxes[lsp_mem_get_builtin_index(m, addr)].name);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_out_stream_write(s, '>');
+}
+
+
+static lsp_status_t write_function(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ lsp_status_t status = lsp_out_stream_write_str(s, "#<function-");
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_out_stream_write_int(s, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_out_stream_write(s, '>');
+}
+
+
+static lsp_status_t write_syntax(lsp_mem_t *m, lsp_out_stream_t *s,
+ lsp_addr_t addr) {
+ lsp_status_t status = lsp_out_stream_write_str(s, "#<syntax-");
+ if (status != LSP_SUCCESS)
+ return status;
+
+ status = lsp_out_stream_write_int(s, addr);
+ if (status != LSP_SUCCESS)
+ return status;
+
+ return lsp_out_stream_write(s, '>');
+}
+
+
+lsp_status_t lsp_write(lsp_mem_t *m, lsp_out_stream_t *s, lsp_addr_t addr) {
+ if (lsp_mem_is_number(m, addr))
+ return write_number(m, s, addr);
+
+ if (lsp_mem_is_pair(m, addr))
+ return write_pair(m, s, addr);
+
+ if (lsp_mem_is_string(m, addr))
+ return write_string(m, s, addr);
+
+ if (lsp_mem_is_symbol(m, addr))
+ return write_symbol(m, s, addr);
+
+ if (lsp_mem_is_builtin_function(m, addr))
+ return write_builtin_function(m, s, addr);
+
+ if (lsp_mem_is_builtin_syntax(m, addr))
+ return write_builtin_syntax(m, s, addr);
+
+ if (lsp_mem_is_function(m, addr))
+ return write_function(m, s, addr);
+
+ if (lsp_mem_is_syntax(m, addr))
+ return write_syntax(m, s, addr);
+
+ return LSP_ERR_WRITE;
+}
diff --git a/src_c/write.h b/src_c/write.h
new file mode 100644
index 0000000..5b7cff1
--- /dev/null
+++ b/src_c/write.h
@@ -0,0 +1,10 @@
+#ifndef LISP16_WRITE_H
+#define LISP16_WRITE_H
+
+#include "mem.h"
+#include "stream.h"
+
+
+lsp_status_t lsp_write(lsp_mem_t *m, lsp_out_stream_t *s, lsp_addr_t addr);
+
+#endif
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2026-02-11 11:21:03 +0000