aboutsummaryrefslogtreecommitdiff
path: root/lisp/lisp.c
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/lisp.c')
-rw-r--r--lisp/lisp.c337
1 files changed, 337 insertions, 0 deletions
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);
+ }
+}
generated by cgit v1.2.3-13-gbd6f (git 2.30.0) at 2025-07-04 21:45:22 +0000