aboutsummaryrefslogtreecommitdiff
path: root/lisp.c
diff options
context:
space:
mode:
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);
- }
-}
generated by cgit v1.2.3-13-gbd6f (git 2.30.0) at 2025-07-05 00:53:51 +0000