344 lines
7.2 KiB
C
344 lines
7.2 KiB
C
/* 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);
|
|
if (!s.data)
|
|
s = member;
|
|
else
|
|
s = sv_concat(&ctx->scratch, s, member);
|
|
|
|
// NOTE: eventually this separator we add per item should be mutable at
|
|
// runtime.
|
|
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);
|
|
}
|
|
}
|