aboutsummaryrefslogtreecommitdiff
path: root/lisp.c
diff options
context:
space:
mode:
authorAryadev Chavali <aryadev@aryadevchavali.com>2025-05-14 21:12:58 +0100
committerAryadev Chavali <aryadev@aryadevchavali.com>2025-05-15 22:25:45 +0100
commit12de1e8db90bccd5a0eefd21075f07c7b7e3dfaa (patch)
tree0434141f2bfd24207a2864f613a1c2e3ee7181fc /lisp.c
parentba5c0a4579ece5d53c009a14d00e683e70b982f4 (diff)
downloadoats-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.c')
-rw-r--r--lisp.c317
1 files changed, 0 insertions, 317 deletions
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 <https://www.gnu.org/licenses/>.
-
- * Created: 2025-04-06
- * Description:
- */
-
-#include "./lisp.h"
-#include "./sv.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);
-}
-
-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);
- }
-}