diff options
author | Aryadev Chavali <aryadev@aryadevchavali.com> | 2025-05-14 21:12:58 +0100 |
---|---|---|
committer | Aryadev Chavali <aryadev@aryadevchavali.com> | 2025-05-15 22:25:45 +0100 |
commit | 12de1e8db90bccd5a0eefd21075f07c7b7e3dfaa (patch) | |
tree | 0434141f2bfd24207a2864f613a1c2e3ee7181fc /lisp | |
parent | ba5c0a4579ece5d53c009a14d00e683e70b982f4 (diff) | |
download | oats-12de1e8db90bccd5a0eefd21075f07c7b7e3dfaa.tar.gz oats-12de1e8db90bccd5a0eefd21075f07c7b7e3dfaa.tar.bz2 oats-12de1e8db90bccd5a0eefd21075f07c7b7e3dfaa.zip |
Refactor for cleanliness
Move files into separate folders for ease of reading, include source
directory so we can use angle bracket includes, adjust build system to
make directories for objects
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/context.c | 92 | ||||
-rw-r--r-- | lisp/context.h | 38 | ||||
-rw-r--r-- | lisp/eval.c | 24 | ||||
-rw-r--r-- | lisp/eval.h | 28 | ||||
-rw-r--r-- | lisp/lisp.c | 337 | ||||
-rw-r--r-- | lisp/lisp.h | 57 | ||||
-rw-r--r-- | lisp/reader.c | 426 | ||||
-rw-r--r-- | lisp/reader.h | 98 | ||||
-rw-r--r-- | lisp/tag.c | 94 | ||||
-rw-r--r-- | lisp/tag.h | 92 |
10 files changed, 1286 insertions, 0 deletions
diff --git a/lisp/context.c b/lisp/context.c new file mode 100644 index 0000000..3b94e54 --- /dev/null +++ b/lisp/context.c @@ -0,0 +1,92 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General + Public License Version 2 + * for details. + + * You may distribute and modify this code under the terms of the + * GNU General Public License Version 2, which you should have received a copy + of along with this + * program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-05-12 + * Description: + */ + +#include <lisp/context.h> + +#include <string.h> + +// Allocates against stable memory i.e. we can have pointers of this lying +// around without any fear of them being thrown away. +void *context_alloc(context_t *context, u64 size) +{ + return arena_alloc(&context->memory, size); +} + +// Allocate against a "scratch space", separate from main memory, for internal +// use. +void *context_salloc(context_t *context, u64 size) +{ + return arena_alloc(&context->scratch, size); +} + +void context_reset_read(context_t *context) +{ + arena_reset(&context->read); +} + +void context_reset_scratch(context_t *context) +{ + arena_reset(&context->scratch); +} + +void context_reset(context_t *context) +{ + arena_reset(&context->memory); + arena_reset(&context->read); + arena_reset(&context->scratch); +} + +void context_cleanup(context_t *context) +{ + if (!context) + return; + arena_cleanup(&context->memory); + arena_cleanup(&context->read); + arena_cleanup(&context->scratch); + memset(context, 0, sizeof(*context)); +} + +void context_report(context_t *context) +{ +#if DEBUG + // Figure this out at runtime + u64 mem_used = 0, mem_cap = 0; + for (page_t *page = context->memory.start; page; page = page->next) + { + mem_used += page->size; + mem_cap += page->capacity; + } + + u64 read_used = 0, read_cap = 0; + for (page_t *page = context->read.start; page; page = page->next) + { + read_used += page->size; + read_cap += page->capacity; + } + + u64 scr_used = 0, scr_cap = 0; + for (page_t *page = context->scratch.start; page; page = page->next) + { + scr_used += page->size; + scr_cap += page->capacity; + } + + info("<Context>: %luB/%luB main memory used\n", mem_used, mem_cap); + info("<Context>: %luB/%luB read space used\n", read_used, read_cap); + info("<Context>: %luB/%luB scratch space used\n", scr_used, scr_cap); +#endif +} diff --git a/lisp/context.h b/lisp/context.h new file mode 100644 index 0000000..2923ad9 --- /dev/null +++ b/lisp/context.h @@ -0,0 +1,38 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General + Public License Version 2 + * for details. + + * You may distribute and modify this code under the terms of the + * GNU General Public License Version 2, which you should have received a copy + of along with this + * program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-05-12 + * Description: + */ + +#ifndef CONTEXT_H +#define CONTEXT_H + +#include <lib/arena.h> + +typedef struct Context +{ + arena_t memory, read, scratch; +} context_t; + +void *context_alloc(context_t *context, u64 size); +void *context_salloc(context_t *context, u64 size); +page_t *context_get_read_page(context_t *ctx); +void context_reset_read(context_t *context); +void context_reset_scratch(context_t *context); + +void context_reset(context_t *context); +void context_cleanup(context_t *context); +void context_report(context_t *context); + +#endif diff --git a/lisp/eval.c b/lisp/eval.c new file mode 100644 index 0000000..3cd05ca --- /dev/null +++ b/lisp/eval.c @@ -0,0 +1,24 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-18 + * Description: Evaluator implementation + */ + +#include <lisp/eval.h> + +err_t eval(context_t *ctx, lisp_t *obj, lisp_t **ret) +{ + (void)ctx; + (void)obj; + (void)ret; + TODO("implement evaluator"); +} diff --git a/lisp/eval.h b/lisp/eval.h new file mode 100644 index 0000000..bc7fb60 --- /dev/null +++ b/lisp/eval.h @@ -0,0 +1,28 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-18 + * Description: Evaluator + */ + +#ifndef EVAL_H +#define EVAL_H + +#include <lisp/lisp.h> + +typedef enum +{ + ERR_OK = 0, +} err_t; + +err_t eval(context_t *ctx, lisp_t *obj, lisp_t **ret); + +#endif diff --git a/lisp/lisp.c b/lisp/lisp.c new file mode 100644 index 0000000..24a4788 --- /dev/null +++ b/lisp/lisp.c @@ -0,0 +1,337 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-06 + * Description: + */ + +#include <lib/sv.h> +#include <lisp/lisp.h> + +#include <stdio.h> +#include <string.h> +#include <wchar.h> + +lisp_t *make_int(i64 integer) +{ + return tag_int(integer); +} + +lisp_t *make_sym(context_t *ctx, char *data, u64 size) +{ + // Small symbol optimisation + if (size <= 7) + return tag_ssym(data, size); + + // Make a cell with the data we need + cell_t *cell = context_alloc(ctx, sizeof(*cell) + size); + cell->size = size; + memcpy(cell->data, data, size); + + return tag_sym(cell); +} + +lisp_t *make_cons(context_t *ctx, lisp_t *car, lisp_t *cdr) +{ + cons_t *cons = context_alloc(ctx, sizeof(*cons)); + memset(cons, 0, sizeof(*cons)); + cons->car = car; + cons->cdr = cdr; + return tag_cons(cons); +} + +lisp_t *make_list(context_t *ctx, lisp_t **lisps, u64 size) +{ + if (!lisps) + return NIL; + lisp_t *cur = NIL; + for (u64 i = size; i > 0; --i) + cur = make_cons(ctx, lisps[i - 1], cur); + return cur; +} + +lisp_t *make_vec(context_t *ctx, u32 size) +{ + // Make a vector with the content + lisp_t *container = NIL; + vec_t *vec = context_alloc(ctx, sizeof(*vec)); + vec->size = 0; + vec->cap = size * sizeof(&container); + if (size == 0) + vec->data = NULL; + else + vec->data = context_alloc(ctx, vec->cap); + container = tag_vec(vec); + + return container; +} + +lisp_t *make_str(context_t *ctx, char *data, u64 size) +{ + if (size == 0) + // No need to allocate unless necessary + return tag_str(NIL); + // Make a vector with the content + vec_t *vec = context_alloc(ctx, sizeof(*vec)); + vec->data = context_alloc(ctx, sizeof(*vec->data) * size); + vec->cap = size; + vec->size = size; + memcpy(vec->data, data, size); + + return tag_str(vec); +} + +i64 as_int(lisp_t *obj) +{ + assert(IS_TAG(obj, INT)); + u64 p_obj = (u64)obj; + return UNTAG(p_obj, INT) | // Delete the tag + (NTH_BYTE(p_obj, 7) & 0x80) << 56 // duplicate the MSB (preserve sign) + ; +} + +cons_t *as_cons(lisp_t *obj) +{ + assert(IS_TAG(obj, CONS)); + return (cons_t *)UNTAG(obj, CONS); +} + +u32 as_char(lisp_t *obj) +{ + return (u32)UNTAG(obj, CHAR); +} + +cell_t *as_sym(lisp_t *obj) +{ + assert(IS_TAG(obj, SYM)); + return (cell_t *)UNTAG(obj, SYM); +} + +void as_ssym(lisp_t *obj, sv_t *container) +{ + assert(IS_TAG(obj, SSYM)); + u64 p_obj = (u64)obj; + container->size = NTH_BYTE(p_obj, 0) >> SHIFT_SSYM; + p_obj >>= 8; + memcpy(container->data, &p_obj, container->size); +} + +bool as_bool(lisp_t *obj) +{ + assert(IS_TAG(obj, BOOL)); + return (bool)UNTAG(obj, BOOL); +} + +f64 as_float(lisp_t *obj) +{ + assert(IS_TAG(obj, FLOAT)); + f64 *f = (f64 *)UNTAG(obj, FLOAT); + return f ? *f : 0; +} + +vec_t *as_vec(lisp_t *obj) +{ + assert(IS_TAG(obj, VEC)); + return (vec_t *)UNTAG(obj, VEC); +} + +vec_t *as_str(lisp_t *obj) +{ + assert(IS_TAG(obj, STR)); + return (vec_t *)UNTAG(obj, STR); +} + +sv_t serialise(context_t *ctx, lisp_t *ptr) +{ + enum Tag t = tag_get(ptr); + switch (t) + { + case TAG_NIL: + { + return SV("NIL", 3); + } + case TAG_INT: + { + i64 i = as_int(ptr); + sv_t s = sv_fmt(&ctx->scratch, +#if DEBUG > 1 + "int[" +#endif + "%ld" +#if DEBUG > 1 + "]" +#endif + , + i); + return s; + } + case TAG_CHAR: + { + u32 codepoint = as_char(ptr); + return sv_fmt(&ctx->scratch, +#if DEBUG > 1 + "char[" +#endif + "%lc" +#if DEBUG > 1 + "]" +#endif + , + codepoint); + } + case TAG_SYM: + { + cell_t *cell = as_sym(ptr); + sv_t s = sv_make(&ctx->scratch, (char *)cell->data, cell->size); +#if DEBUG > 1 + s = sv_fmt(&ctx->scratch, "sym[" PR_SV "]", SV_FMT(s)); +#endif + return s; + } + case TAG_SSYM: + { + char data[7]; + sv_t rsym = SV(data, 0); + as_ssym(ptr, &rsym); + sv_t s = sv_copy(&ctx->scratch, rsym); + +#if DEBUG > 1 + s = sv_fmt(&ctx->scratch, "ssym[" PR_SV "]", SV_FMT(s)); +#endif + return s; + } + case TAG_BOOL: + { + return sv_fmt(&ctx->scratch, +#if DEBUG > 1 + "bool[" +#endif + "%s" +#if DEBUG > 1 + "]" +#endif + , + as_bool(ptr) ? "#t" : "#f"); + } + case TAG_FLOAT: + { + return sv_fmt(&ctx->scratch, +#if DEBUG > 1 + "float[" +#endif + "%lf" +#if DEBUG > 1 + "]" +#endif + , + as_float(ptr)); + } + case TAG_CONS: + { + if (!CAR(ptr) && !CDR(ptr)) +#if DEBUG > 1 + return SV("lst[NIL]", 8); +#else + return SV("NIL", 3); +#endif + + sv_t s = {0}; + + for (lisp_t *lsp = ptr; lsp; lsp = IS_TAG(lsp, CONS) ? CDR(lsp) : NIL) + { + lisp_t *lmember = lsp; + if (IS_TAG(lsp, CONS)) + lmember = CAR(lmember); + + sv_t member = serialise(ctx, lmember); + s = sv_concat(&ctx->scratch, s, member); + if (IS_TAG(lsp, CONS) && !CDR(lsp)) + continue; + else if (IS_TAG(CDR(lsp), CONS)) + // normal list + s = sv_append(&ctx->scratch, s, " ", 1); + else + // dotted list + s = sv_append(&ctx->scratch, s, " . ", 3); + } + +#if DEBUG > 1 + s = sv_fmt(&ctx->scratch, "lst[" PR_SV "]", SV_FMT(s)); +#else + s = sv_fmt(&ctx->scratch, "(" PR_SV ")", SV_FMT(s)); +#endif + return s; + } + case TAG_VEC: + { + vec_t *vec = as_vec(ptr); + if (!vec) +#if DEBUG > 1 + return SV("vec[NIL]", 8); +#else + return SV("#()", 3); +#endif + else if (vec->size < sizeof(&ptr)) +#if DEBUG > 1 + return SV("vec[0/0 #()]", 13); +#else + return SV("#()", 3); +#endif + + sv_t s = {0}; + for (u64 i = 0; i < vec->size / sizeof(&ptr); ++i) + { + lisp_t *lmember = ((lisp_t **)vec->data)[i]; + sv_t member = serialise(ctx, lmember); + s = sv_concat(&ctx->scratch, s, member); + if (i == ((vec->size / sizeof(&ptr)) - 1)) + continue; + s = sv_append(&ctx->scratch, s, " ", 1); + } + +#if DEBUG > 1 + s = sv_fmt(&ctx->scratch, "vec[%lu/%lu #(" PR_SV ")]", vec->size, vec->cap, + SV_FMT(s)); +#else + s = sv_fmt(&ctx->scratch, "#(" PR_SV ")", SV_FMT(s)); +#endif + return s; + break; + } + case TAG_STR: + { + vec_t *vec = as_str(ptr); + sv_t sv = {0}; + if (vec) + sv = SV((char *)vec->data, vec->size); + else + sv = SV("", 0); + return sv_fmt(&ctx->scratch, +#if DEBUG > 1 + "str[" +#else + "\"" +#endif + PR_SV +#if DEBUG > 1 + "]" +#else + "\"" +#endif + , + SV_FMT(sv)); + } + case NUM_TAGS: + default: + assert(false && "serialise: unreachable"); + return SV(0, 0); + } +} diff --git a/lisp/lisp.h b/lisp/lisp.h new file mode 100644 index 0000000..2892bdb --- /dev/null +++ b/lisp/lisp.h @@ -0,0 +1,57 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-06 + * Description: Object model where we deal with contexts + */ + +#ifndef LISP_H +#define LISP_H + +#include <lib/sv.h> +#include <lib/vec.h> +#include <lisp/context.h> +#include <lisp/tag.h> + +typedef struct Cons +{ + lisp_t *car, *cdr; +} cons_t; + +typedef struct Cell +{ + u64 size; + u8 data[]; +} cell_t; + +lisp_t *make_int(i64 integer); +lisp_t *make_sym(context_t *ctx, char *data, u64 size); +lisp_t *make_cons(context_t *ctx, lisp_t *car, lisp_t *cdr); +lisp_t *make_list(context_t *ctx, lisp_t **lisps, u64 size); +lisp_t *make_vec(context_t *ctx, u32 size); +lisp_t *make_str(context_t *ctx, char *data, u64 size); + +i64 as_int(lisp_t *obj); +u32 as_char(lisp_t *obj); +cell_t *as_sym(lisp_t *obj); +void as_ssym(lisp_t *obj, sv_t *sv); +bool as_bool(lisp_t *obj); +f64 as_float(lisp_t *obj); +cons_t *as_cons(lisp_t *obj); +vec_t *as_vec(lisp_t *obj); +vec_t *as_str(lisp_t *obj); + +sv_t serialise(context_t *ctx, lisp_t *lisp); + +#define CAR(PTR) (as_cons(PTR)->car) +#define CDR(PTR) (as_cons(PTR)->cdr) + +#endif diff --git a/lisp/reader.c b/lisp/reader.c new file mode 100644 index 0000000..0c8a914 --- /dev/null +++ b/lisp/reader.c @@ -0,0 +1,426 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-16 + * Description: Implementation of parser + */ + +#include <lisp/reader.h> + +#include <ctype.h> +#include <string.h> + +bool is_digit(char c) +{ + return isdigit(c); +} + +bool is_alpha(char c) +{ + return isalpha(c); +} + +bool is_space(char c) +{ + return isspace(c); +} + +bool is_skip(char c) +{ + return is_space(c) || c == ';'; +} + +bool is_sym(char c) +{ + return strchr(SYM_CHARS, c) != NULL; +} + +void input_from_sv(context_t *ctx, input_t *inp, const char *name, sv_t sv) +{ + inp->name = name; + inp->str = sv_copy(&ctx->read, sv); +} + +void input_from_fp(context_t *ctx, input_t *input, const char *name, FILE *fp) +{ + input->name = name; + // TODO: Choose a best fit (i.e. maximal capacity, unused) page + page_t *page = page_create(INPUT_CHUNK_SIZE); + // chunk should be in scratch space so we can reset it later. + char *chunk = context_salloc(ctx, INPUT_CHUNK_SIZE); + + u64 total_size = 0, size_read = 0; + while (!feof(fp)) + { + size_read = fread(chunk, 1, INPUT_CHUNK_SIZE, fp); + if (size_read > 0) + { + page_rappend(&page, chunk, size_read); + total_size += size_read; + } + } + + input->str = SV((char *)page->data, total_size); + + // Memory cleanup + context_reset_scratch(ctx); + arena_attach(&ctx->read, page); +} + +bool input_eof(input_t *input) +{ + return !input || (input->offset >= input->str.size) || + (input->str.data[input->offset] == '\0'); +} + +char input_peek(input_t *input, u64 offset) +{ + if (input_eof(input) || input->offset + offset >= input->str.size) + return '\0'; + return input->str.data[input->offset + offset]; +} + +char input_next(input_t *input, u64 offset) +{ + if (input_eof(input) || input->offset + offset >= input->str.size) + return '\0'; + input->offset += offset; + return input->str.data[input->offset]; +} + +void input_skip(input_t *inp) +{ + while (!input_eof(inp)) + { + sv_t current = sv_cut(inp->str, inp->offset); + // Skip any whitespace + inp->offset += sv_while(current, is_space); + current = sv_cut(inp->str, inp->offset); + // Is there a comment to skip? + if (current.size && current.data[0] == ';') + { + // Skip till newline + i64 newline = sv_find_subcstr(current, "\n", 1); + if (newline < 0) + inp->offset = inp->str.size; + else + inp->offset += newline + 1; + // Then skip any whitespace + } + // Multiline comment to skip? + else if (current.size > 2 && strncmp(current.data, "#|", 2) == 0) + { + i64 offset = sv_find_subcstr(current, "|#", 2); + if (offset < 0) + inp->offset = inp->str.size; + else + inp->offset += offset + 2; + // Then skip any whitespace + } + // Nothing to skip, stop. + else + break; + } + return; +} + +perr_t parse_int(context_t *ctx, input_t *inp, lisp_t **ret) +{ + debug("parse_int[%lu] => ", inp->offset); + + // TODO: Parse arbitrary sized integers + (void)ctx; + + bool negative = (input_peek(inp, 0) == '-'); + sv_t current = sv_cut(inp->str, inp->offset + (negative ? 1 : 0)); + sv_t digits = sv_chop(current, sv_while(current, is_digit)); + + debug("`" PR_SV "` => ", SV_FMT(digits)); + i64 x = (negative ? -1L : 1L) * strtol(digits.data, NULL, 10); + debug("%ld\n", x); + + input_next(inp, digits.size + (negative ? 1 : 0)); + + *ret = make_int(x); + return PERR_OK; +} + +perr_t parse_sym(context_t *ctx, input_t *inp, lisp_t **ret) +{ + debug("parse_sym[%lu] => ", inp->offset); + + sv_t current = sv_cut(inp->str, inp->offset); + sv_t sym = sv_chop(current, sv_while(current, is_sym)); + debug("`" PR_SV "`\n", SV_FMT(sym)); + + if (sym.size == 3) + { + // NOTE: We can't mutate sym directly because it's on `read` space. + + // TODO: Make this beautiful please. + char buf[3]; + for (u64 i = 0; i < 3; ++i) + buf[i] = toupper(sym.data[i]); + + // NOTE: NIL symbol to actual NIL + if (strncmp(buf, "NIL", 3) == 0) + { + input_next(inp, 3); + return NIL; + } + } + + lisp_t *lsym = make_sym(ctx, sym.data, sym.size); + input_next(inp, sym.size); + *ret = lsym; + + return PERR_OK; +} + +perr_t parse_bool(context_t *ctx, input_t *inp, lisp_t **ret) +{ + (void)ctx; + debug("parse_bool[%lu] => ", inp->offset); + char c = input_peek(inp, 1); + bool b = -1; + if (c == 't') + b = true; + else if (c == 'f') + b = false; + else + return PERR_EXPECTED_BOOLEAN; + *ret = tag_bool(b); + input_next(inp, 2); + return PERR_OK; +} + +perr_t parse_cons(context_t *ctx, input_t *inp, lisp_t **ret) +{ + // TODO: Put this in a symbol table + lisp_t *lisp_dot = make_sym(ctx, ".", 1); + debug("parse_cons[%lu] => (\n", inp->offset); + inp->offset += 1; + + lisp_t *root = NIL; + lisp_t **cur = NIL; + bool dotted = false; + + while (!input_eof(inp) && input_peek(inp, 0) != ')') + { + lisp_t *lisp = NIL; + perr_t res = parse(ctx, inp, &lisp); + if (res) + return res; + + // This is cheap to do + if (lisp == lisp_dot) + { + dotted = true; + continue; + } + + if (!root) + { + root = make_cons(ctx, lisp, NIL); + cur = &root; + } + else if (!dotted) + *cur = make_cons(ctx, lisp, NIL); + else + *cur = lisp; + + if (cur && !dotted) + cur = &as_cons(*cur)->cdr; + + input_skip(inp); + } + + if (input_peek(inp, 0) != ')') + return PERR_EXPECTED_CLOSE_BRACKET; + + input_next(inp, 1); + + debug(")\n"); + *ret = root; + return PERR_OK; +} + +perr_t parse_vec(context_t *ctx, input_t *inp, lisp_t **ret) +{ + debug("parse_vec[%lu] => [\n", inp->offset); + input_next(inp, 2); + + lisp_t *lvec = make_vec(ctx, 0); + vec_t *vec = as_vec(lvec); + + while (!input_eof(inp) && input_peek(inp, 0) != ')') + { + lisp_t *lisp = NIL; + perr_t res = parse(ctx, inp, &lisp); + if (res) + return res; + + vec_append(&ctx->memory, vec, &lisp, sizeof(lisp)); + input_skip(inp); + } + + if (input_peek(inp, 0) != ')') + return PERR_EXPECTED_CLOSE_BRACKET; + + input_next(inp, 1); + + debug("]\n"); + *ret = lvec; + return PERR_OK; +} + +perr_t parse_str(context_t *ctx, input_t *inp, lisp_t **ret) +{ + debug("parse_str[%lu] => ", inp->offset); + input_next(inp, 1); // 1 for the first speechmark + sv_t sv = sv_cut(inp->str, inp->offset); + i64 size = sv_find_subcstr(sv, "\"", 1); + if (size < 0) + return PERR_EXPECTED_SPEECH_MARK; + + input_next(inp, size + 1); // 1 for that last speechmark + sv_t str_content = sv_chop(sv, size); + debug("\"" PR_SV "\"\n", SV_FMT(str_content)); + *ret = make_str(ctx, str_content.data, str_content.size); + return PERR_OK; +} + +perr_t parse_quote(context_t *ctx, input_t *inp, lisp_t **ret) +{ + char c = input_peek(inp, 0); + if (!(c == '\'' || c == '`')) + return PERR_UNEXPECTED_CHAR; + input_next(inp, 1); + sv_t prefix = {0}; + if (c == '\'') + prefix = SV("quote", 5); + else if (c == '`') + prefix = SV("quasiquote", 10); + lisp_t *root = make_cons(ctx, make_sym(ctx, prefix.data, prefix.size), NIL); + lisp_t *rest = NIL; + perr_t perr = parse(ctx, inp, &rest); + if (perr) + return perr; + CDR(root) = make_cons(ctx, rest, NIL); + *ret = root; + return PERR_OK; +} + +// TODO: Make this interactable with user once we have evaluation +perr_t parse_reader_macro(context_t *ctx, input_t *inp, lisp_t **ret) +{ + char c = input_peek(inp, 1); + if (c == '\\') + { + // character or weird base integer + TODO("Not implemented reader macro for characters or weird bases"); + } + else if (c == '(') + return parse_vec(ctx, inp, ret); + else if (c == 't' || c == 'f') + return parse_bool(ctx, inp, ret); + else if (c == 'e') + { + // Scientific notation for floats + } + return PERR_UNEXPECTED_READER_MACRO_SYMBOL; +} + +static_assert(NUM_TAGS == 9); +perr_t parse(context_t *ctx, input_t *inp, lisp_t **ret) +{ + debug("parse => "); + input_skip(inp); + if (input_eof(inp)) + return PERR_EOF; + + char c = input_peek(inp, 0); + + if (is_digit(c) || (c == '-' && is_digit(input_peek(inp, 1)))) + return parse_int(ctx, inp, ret); + else if (c == '#') + return parse_reader_macro(ctx, inp, ret); + else if (is_sym(c)) + return parse_sym(ctx, inp, ret); + else if (c == '(') + return parse_cons(ctx, inp, ret); + else if (c == '\'' || c == '`') + return parse_quote(ctx, inp, ret); + else if (c == '\"') + return parse_str(ctx, inp, ret); + else + return PERR_UNEXPECTED_CHAR; +} + +perr_t parse_all(context_t *ctx, input_t *inp, vec_t *vec) +{ + while (!input_eof(inp)) + { + lisp_t *member = NIL; + perr_t err = parse(ctx, inp, &member); + + if (err) + return err; + else + vec_append(&ctx->scratch, vec, &member, sizeof(member)); + + input_skip(inp); + } + return PERR_OK; +} + +int print_perror(FILE *fp, input_t *inp, perr_t error) +{ + pos_t pos = input_offset_to_pos(inp); + fprintf(fp, "%s:%lu:%lu: %s", inp->name, pos.line, pos.col, + perr_to_cstr(error)); + switch (error) + { + case PERR_UNEXPECTED_CHAR: + fprintf(fp, "(`%c`)", input_peek(inp, 0)); + break; + case PERR_OK: + case PERR_EOF: + case PERR_EXPECTED_BOOLEAN: + case PERR_UNEXPECTED_READER_MACRO_SYMBOL: + case PERR_EXPECTED_CLOSE_BRACKET: + case PERR_EXPECTED_SPEECH_MARK: + default: + break; + } + fprintf(stderr, "\n"); + + return error; +} + +pos_t input_offset_to_pos(input_t *inp) +{ + pos_t pos = {.col = 1, .line = 1}; + for (u64 i = 0; i < inp->offset && i < inp->str.size; ++i) + { + char c = (inp->str.data[i]); + if (c == '\n') + { + ++pos.line; + pos.col = 1; + } + else + { + ++pos.col; + } + } + return pos; +} diff --git a/lisp/reader.h b/lisp/reader.h new file mode 100644 index 0000000..4bd0578 --- /dev/null +++ b/lisp/reader.h @@ -0,0 +1,98 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-16 + * Description: Parsing Lisp! + */ + +#ifndef READER_H +#define READER_H + +#include <lib/vec.h> +#include <lisp/context.h> +#include <lisp/lisp.h> + +#define INPUT_CHUNK_SIZE 512 +static const char SYM_CHARS[] = + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" + "¬!£$%^&*_-+={[]}:@~#<,>.?/"; + +typedef struct +{ + const char *name; + u64 offset; + sv_t str; +} input_t; + +void input_from_sv(context_t *ctx, input_t *inp, const char *name, sv_t sv); +void input_from_fp(context_t *ctx, input_t *input, const char *name, FILE *fp); +bool input_eof(input_t *input); + +typedef struct +{ + u64 col, line; +} pos_t; + +pos_t input_offset_to_pos(input_t *inp); + +typedef enum +{ + PERR_OK = 0, + PERR_EOF, + PERR_UNEXPECTED_CHAR, + PERR_EXPECTED_CLOSE_BRACKET, + PERR_EXPECTED_SPEECH_MARK, + PERR_UNEXPECTED_READER_MACRO_SYMBOL, + PERR_EXPECTED_BOOLEAN, +} perr_t; + +static inline const char *perr_to_cstr(perr_t perr) +{ + switch (perr) + { + case PERR_OK: + return "OK"; + break; + case PERR_EOF: + return "EOF"; + break; + case PERR_UNEXPECTED_CHAR: + return "UNEXPECTED_CHAR"; + break; + case PERR_EXPECTED_CLOSE_BRACKET: + return "EXPECTED_CLOSE_BRACKET"; + break; + case PERR_EXPECTED_SPEECH_MARK: + return "EXPECTED_SPEECH_MARK"; + break; + case PERR_UNEXPECTED_READER_MACRO_SYMBOL: + return "UNEXPECTED_READER_MACRO_SYMBOL"; + break; + case PERR_EXPECTED_BOOLEAN: + return "EXPECTED_BOOLEAN"; + break; + } + assert(false && "perr_to_cstr: unreachable"); + return ""; +} + +typedef struct +{ + lisp_t *result; + perr_t error; +} pres_t; + +perr_t parse(context_t *ctx, input_t *str, lisp_t **ret); +perr_t parse_all(context_t *ctx, input_t *str, vec_t *vec); + +int print_perror(FILE *fp, input_t *inp, perr_t error); + +#endif diff --git a/lisp/tag.c b/lisp/tag.c new file mode 100644 index 0000000..26db6d5 --- /dev/null +++ b/lisp/tag.c @@ -0,0 +1,94 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-06 + * Description: + */ + +#include <lisp/tag.h> +#include <string.h> + +lisp_t *tag_int(i64 i) +{ + return TAG((u64)i, INT); +} + +lisp_t *tag_cons(void *ptr) +{ + return TAG((u64)ptr, CONS); +} + +lisp_t *tag_sym(void *ptr) +{ + return TAG((u64)ptr, SYM); +} + +lisp_t *tag_ssym(const char *data, size_t size) +{ + assert(size <= 7); + u8 buffer[sizeof(u64)]; + memset(buffer, 0, sizeof(buffer)); + // in 8 bits we have: + // size - 3 bits (up to 7) + // tag - 5 bits + buffer[0] = size; + buffer[0] <<= SHIFT_SSYM; + buffer[0] |= TAG_SSYM; + memcpy(buffer + 1, data, size); + u64 word = 0; + memcpy(&word, buffer, sizeof(u64)); + return (lisp_t *)word; +} + +lisp_t *tag_bool(bool b) +{ + return TAG((u64)b, BOOL); +} + +lisp_t *tag_vec(void *ptr) +{ + return TAG((u64)ptr, VEC); +} + +lisp_t *tag_str(void *ptr) +{ + return TAG((u64)ptr, STR); +} + +lisp_t *tag_char(u32 codepoint) +{ + u64 w = codepoint; + return TAG(w, CHAR); +} + +enum Tag tag_get(lisp_t *ptr) +{ + static_assert(NUM_TAGS == 9); + if (!ptr) + return TAG_NIL; + else if (IS_TAG(ptr, INT)) + return TAG_INT; + else if (IS_TAG(ptr, CHAR)) + return TAG_CHAR; + else if (IS_TAG(ptr, SYM)) + return TAG_SYM; + else if (IS_TAG(ptr, SSYM)) + return TAG_SSYM; + else if (IS_TAG(ptr, BOOL)) + return TAG_BOOL; + else if (IS_TAG(ptr, VEC)) + return TAG_VEC; + else if (IS_TAG(ptr, STR)) + return TAG_STR; + else if (IS_TAG(ptr, CONS)) + return TAG_CONS; + return 0; +} diff --git a/lisp/tag.h b/lisp/tag.h new file mode 100644 index 0000000..06b7b3f --- /dev/null +++ b/lisp/tag.h @@ -0,0 +1,92 @@ +/* Copyright (C) 2025 Aryadev Chavali + + * This program is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU General Public License Version 2 for + * details. + + * You may distribute and modify this code under the terms of the GNU General + * Public License Version 2, which you should have received a copy of along with + * this program. If not, please go to <https://www.gnu.org/licenses/>. + + * Created: 2025-04-06 + * Description: + */ + +#ifndef TAG_H +#define TAG_H + +#include <base.h> + +#include <stdbool.h> +#include <stdlib.h> + +// Opaque structure to make tagged pointers a separate type from general +// pointers +typedef struct Obj lisp_t; + +#define NIL NULL + +enum Tag +{ + TAG_NIL = 0b00000000, // Atomic types + TAG_INT = 0b00000001, // special so we can encode 63 bit integers + TAG_SYM = 0b00000100, + TAG_SSYM = 0b00001000, + TAG_CHAR = 0b00001100, + TAG_BOOL = 0b00010000, + TAG_FLOAT = 0b00010100, + TAG_CONS = 0b00000010, // Container types + TAG_VEC = 0b00000110, + TAG_STR = 0b00001010, + + NUM_TAGS = 9, +}; + +enum Shift +{ + SHIFT_INT = 1, + SHIFT_SSYM = 5, + SHIFT_CHAR = 8, + SHIFT_SYM = 8, + SHIFT_BOOL = 8, + SHIFT_FLOAT = 8, + + SHIFT_CONS = 8, + SHIFT_VEC = 8, + SHIFT_STR = 8, +}; + +enum Mask +{ + MASK_INT = 0b00000001, + MASK_SSYM = 0b00011111, + MASK_SYM = 0b11111111, + MASK_CHAR = 0b11111111, + MASK_BOOL = 0b11111111, + MASK_FLOAT = 0b11111111, + + MASK_CONS = 0b11111111, + MASK_VEC = 0b11111111, + MASK_STR = 0b11111111, +}; + +#define TAG(PTR, TYPE) ((lisp_t *)(((PTR) << SHIFT_##TYPE) | TAG_##TYPE)) +#define IS_TAG(PTR, TYPE) (((u64)(PTR) & MASK_##TYPE) == TAG_##TYPE) +#define UNTAG(PTR, TYPE) (((u64)PTR) >> SHIFT_##TYPE) + +enum Tag tag_get(lisp_t *ptr); + +lisp_t *tag_int(i64 i); +lisp_t *tag_char(u32 codepoint); +lisp_t *tag_sym(void *ptr); +lisp_t *tag_ssym(const char *data, size_t size); +lisp_t *tag_bool(bool b); +lisp_t *tag_vec(void *ptr); +lisp_t *tag_str(void *ptr); +lisp_t *tag_cons(void *ptr); + +#define INT_MAX ((1L << 62) - 1) +#define INT_MIN (-(1L << 62)) + +#endif |