From 12de1e8db90bccd5a0eefd21075f07c7b7e3dfaa Mon Sep 17 00:00:00 2001 From: Aryadev Chavali Date: Wed, 14 May 2025 21:12:58 +0100 Subject: 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 --- lisp.c | 317 ----------------------------------------------------------------- 1 file changed, 317 deletions(-) delete mode 100644 lisp.c (limited to 'lisp.c') diff --git a/lisp.c b/lisp.c deleted file mode 100644 index 5ee7a19..0000000 --- a/lisp.c +++ /dev/null @@ -1,317 +0,0 @@ -/* 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 . - - * Created: 2025-04-06 - * Description: - */ - -#include "./lisp.h" -#include "./sv.h" - -#include -#include -#include - -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); -} - -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_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); - } -} -- cgit v1.2.3-13-gbd6f