Compare commits

...

20 Commits

Author SHA1 Message Date
Aryadev Chavali
d88523d39f allocator: rework alloc_delete
Added a switch case at start of alloc_delete to only run it on
container (read: heap allocated) types.

If adding to free vector, iterate through free vector first to ensure
we've not added it already.  Reset the object before adding it, so
reuse is trivial.
2026-03-05 22:24:10 +00:00
Aryadev Chavali
13f3de726b sys: sys_delete -> calls alloc_delete 2026-03-05 22:21:00 +00:00
Aryadev Chavali
8231cf4e14 allocator: "padding" field for alloc_metadata_t, static_assert on sizeof 2026-03-05 22:20:10 +00:00
Aryadev Chavali
55ed8c5939 lisp: lisp_reset, vec: vec_reset
Reset method to "clear the memory" of a lisp object.  Only operates on
heap allocated objects.
2026-03-05 22:11:23 +00:00
Aryadev Chavali
edce319957 main: fix issue with unused variable on release mode builds 2026-03-05 20:33:41 +00:00
Aryadev Chavali
775d9f51bf reader: add position restoration for read_vec and read_list
Same as read_str really, using a label to push control flow.
2026-03-05 20:27:13 +00:00
Aryadev Chavali
c65ec319f5 lisp: lisp_print: implement support for strings 2026-03-05 20:27:00 +00:00
Aryadev Chavali
fd9cc93c45 lisp: lisp_print: fix issue with extra space when printing vectors 2026-03-05 20:26:40 +00:00
Aryadev Chavali
e594b6ce70 reader: read_str restores stream position for no closing speechmarks
Say you have the following Lisp code: `"hello world` (no closing
speechmark).  This read_str implementation will now place
stream->position at the first speechmark rather than at the
EOF (what happened previously) which is a bit nicer.
2026-03-05 20:25:03 +00:00
Aryadev Chavali
fee6614670 reader: implement reader for strings 2026-03-05 20:13:52 +00:00
Aryadev Chavali
1998954b56 reader: slight adjustments based on change INT -> SMI 2026-03-05 20:13:18 +00:00
Aryadev Chavali
e629b9919e Makefile: added -Wswitch-enum to warning flags 2026-03-05 19:59:59 +00:00
Aryadev Chavali
37d1764c6e reader: use make_list in read_quote 2026-03-05 19:59:46 +00:00
Aryadev Chavali
cb8d1b1139 sys: make_list constructor
Takes a fixed array of lisp_t pointers, and makes a cons list out of
them.
2026-03-05 19:59:23 +00:00
Aryadev Chavali
2a13c89496 doc: add r7rs PDF for reference 2026-03-05 19:48:00 +00:00
Aryadev Chavali
b925a68986 vec: FOR_VEC macro 2026-03-05 19:47:46 +00:00
Aryadev Chavali
99448f6702 allocator|lisp: support for strings 2026-03-05 19:47:03 +00:00
Aryadev Chavali
bbb66d5fb1 string: new string library
Strings are simply byte vectors.  We want a separate type so when
tagging/untagging we can have some level of type separation.
2026-03-05 19:44:58 +00:00
Aryadev Chavali
b93042fd27 lisp: INT -> SMI
when we implement big integer support, we should use INT there
instead.  SMI signals intent much better.
2026-03-05 19:41:16 +00:00
Aryadev Chavali
a50ca72b24 lisp: 63 bit -> 56 bit SMI
This massively simplifies the tagging implementation as all types now
have a 1 byte tag.  However, this does make the need for Big Integers
much greater as we've lost 8 bits of precision.
2026-03-05 18:36:43 +00:00
16 changed files with 386 additions and 132 deletions

View File

@@ -5,7 +5,7 @@ OUT=$(DIST)/alisp.out
TEST=$(DIST)/test.out TEST=$(DIST)/test.out
LDFLAGS= LDFLAGS=
GFLAGS=-Wall -Wextra -Wpedantic -Werror -std=c23 -I./include/ GFLAGS=-Wall -Wextra -Wswitch-enum -Wpedantic -Werror -std=c23 -I./include/
DFLAGS=-ggdb -fsanitize=address -fsanitize=undefined DFLAGS=-ggdb -fsanitize=address -fsanitize=undefined
RFLAGS=-O3 RFLAGS=-O3
@@ -19,8 +19,8 @@ CFLAGS=$(GFLAGS) $(DFLAGS) -DVERBOSE_LOGS=2 -DTEST_VERBOSE=1
endif endif
# Units to compile # Units to compile
UNITS=src/sv.c src/vec.c src/stream.c src/symtable.c src/lisp.c src/allocator.c \ UNITS=src/sv.c src/vec.c src/string.c src/stream.c src/symtable.c src/lisp.c \
src/sys.c src/reader.c src/allocator.c src/sys.c src/reader.c
OBJECTS:=$(patsubst src/%.c, $(DIST)/%.o, $(UNITS)) OBJECTS:=$(patsubst src/%.c, $(DIST)/%.o, $(UNITS))
TEST_UNITS=test/main.c TEST_UNITS=test/main.c

BIN
doc/r7rs.pdf Normal file

Binary file not shown.

View File

@@ -15,10 +15,14 @@
typedef struct typedef struct
{ {
u64 padding : 56;
tag_t tag : 8;
u64 references; u64 references;
tag_t tag : 8;
} alloc_metadata_t; } alloc_metadata_t;
static_assert(sizeof(alloc_metadata_t) == 16,
"16 byte metadata required for alignment purposes");
typedef struct typedef struct
{ {
alloc_metadata_t metadata; alloc_metadata_t metadata;

View File

@@ -10,7 +10,7 @@
#include <stdio.h> #include <stdio.h>
#include <alisp/symtable.h> #include <alisp/string.h>
#include <alisp/vec.h> #include <alisp/vec.h>
#define NIL 0 #define NIL 0
@@ -26,59 +26,50 @@ typedef struct
/// Tagging system /// Tagging system
typedef enum Tag typedef enum Tag
{ {
TAG_NIL = 0b00000000, // Start of atomic types TAG_SMI = 0b00000001, // Atomic types
TAG_INT = 0b00000001, // Special tag so we can encode 63 bit integers TAG_SYM = 0b00000011,
TAG_SYM = 0b00000100, TAG_NIL = 0b00000000, // Container types (0 LSB)
TAG_CONS = 0b00000010, // Start of container types TAG_CONS = 0b00000010,
TAG_VEC = 0b00000110, TAG_VEC = 0b00000100,
NUM_TAGS = 5, TAG_STR = 0b00000110,
NUM_TAGS = 6,
} tag_t; } tag_t;
static_assert(NUM_TAGS == 5, "Expected NUM_TAGS == 5 for enum SHIFT");
enum Shift
{
SHIFT_INT = 1,
SHIFT_SYM = 8,
SHIFT_CONS = 8,
SHIFT_VEC = 8,
};
static_assert(NUM_TAGS == 5, "Expected NUM_TAGS == 5 for enum MASK");
enum Mask
{
MASK_INT = 0b00000001,
MASK_SYM = 0b11111111,
MASK_CONS = 0b11111111,
MASK_VEC = 0b11111111,
};
// Some helper macros for tagging // Some helper macros for tagging
#define TAG(PTR, TYPE) ((lisp_t *)(((PTR) << SHIFT_##TYPE) | TAG_##TYPE)) #define SHIFT_TAG (8)
#define IS_TAG(PTR, TYPE) (((u64)(PTR) & MASK_##TYPE) == TAG_##TYPE) #define MASK_TAG ((1 << SHIFT_TAG) - 1)
#define UNTAG(PTR, TYPE) (((u64)PTR) >> SHIFT_##TYPE)
#define INT_MAX ((((i64)1) << 62) - 1) #define TAG(PTR, TYPE) ((lisp_t *)((((u64)(PTR)) << SHIFT_TAG) | TAG_##TYPE))
#define INT_MIN (-(((i64)1) << 62)) #define UNTAG(PTR) (((u64)PTR) >> SHIFT_TAG)
#define GET_TAG(PTR) ((tag_t)(((u64)(PTR)) & MASK_TAG))
#define IS_TAG(PTR, TYPE) (GET_TAG(PTR) == TAG_##TYPE)
tag_t get_tag(const lisp_t *); #define INT_BITS ((sizeof(i64) * 8) - SHIFT_TAG)
lisp_t *tag_int(const i64); #define INT_MAX ((((i64)1) << (INT_BITS - 1)) - 1)
#define INT_MIN (-(INT_MAX + 1))
tag_t tag_get(const lisp_t *);
u64 tag_sizeof(tag_t);
u64 lisp_sizeof(lisp_t *);
lisp_t *lisp_reset(lisp_t *);
void lisp_print(FILE *, lisp_t *);
lisp_t *tag_smi(const i64);
lisp_t *tag_sym(const char *); lisp_t *tag_sym(const char *);
lisp_t *tag_cons(const cons_t *); lisp_t *tag_cons(const cons_t *);
lisp_t *tag_vec(const vec_t *); lisp_t *tag_vec(const vec_t *);
lisp_t *tag_str(const str_t *);
lisp_t *tag_generic(void *, tag_t); lisp_t *tag_generic(void *, tag_t);
i64 as_int(lisp_t *); i64 as_smi(lisp_t *);
char *as_sym(lisp_t *); char *as_sym(lisp_t *);
cons_t *as_cons(lisp_t *); cons_t *as_cons(lisp_t *);
vec_t *as_vec(lisp_t *); vec_t *as_vec(lisp_t *);
str_t *as_str(lisp_t *);
#define CAR(L) (as_cons(L)->car) #define CAR(L) (as_cons(L)->car)
#define CDR(L) (as_cons(L)->cdr) #define CDR(L) (as_cons(L)->cdr)
void lisp_print(FILE *, lisp_t *);
u64 tag_sizeof(tag_t);
u64 lisp_sizeof(lisp_t *);
#endif #endif
/* Copyright (C) 2026 Aryadev Chavali /* Copyright (C) 2026 Aryadev Chavali

View File

@@ -17,6 +17,7 @@ typedef enum
READ_ERR_EOF, READ_ERR_EOF,
READ_ERR_EXPECTED_CLOSED_BRACE, READ_ERR_EXPECTED_CLOSED_BRACE,
READ_ERR_EXPECTED_CLOSED_SQUARE_BRACKET, READ_ERR_EXPECTED_CLOSED_SQUARE_BRACKET,
READ_ERR_EXPECTED_CLOSING_SPEECHMARKS,
READ_ERR_UNEXPECTED_CLOSED_BRACE, READ_ERR_UNEXPECTED_CLOSED_BRACE,
READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET, READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET,
READ_ERR_UNKNOWN_CHAR, READ_ERR_UNKNOWN_CHAR,

35
include/alisp/string.h Normal file
View File

@@ -0,0 +1,35 @@
/* string.h: String library
* Created: 2026-03-05
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#ifndef STRING_H
#define STRING_H
#include <alisp/sv.h>
#include <alisp/vec.h>
typedef struct
{
vec_t data;
} str_t;
str_t string_make(sv_t sv);
sv_t string_sv(str_t *);
#endif
/* Copyright (C) 2026 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/>.
*/

View File

@@ -10,6 +10,7 @@
#include <alisp/allocator.h> #include <alisp/allocator.h>
#include <alisp/lisp.h> #include <alisp/lisp.h>
#include <alisp/symtable.h>
/// System context /// System context
typedef struct typedef struct
@@ -20,6 +21,7 @@ typedef struct
void sys_init(sys_t *); void sys_init(sys_t *);
lisp_t *sys_alloc(sys_t *, tag_t type); lisp_t *sys_alloc(sys_t *, tag_t type);
void sys_delete(sys_t *, lisp_t *);
void sys_free(sys_t *); void sys_free(sys_t *);
// Debugging function: provides total memory usage from system. // Debugging function: provides total memory usage from system.
@@ -27,15 +29,17 @@ u64 sys_cost(sys_t *);
/// Constructors and general Lisp API /// Constructors and general Lisp API
lisp_t *make_int(i64); lisp_t *make_int(i64);
lisp_t *make_vec(sys_t *, u64);
lisp_t *intern(sys_t *, sv_t); lisp_t *intern(sys_t *, sv_t);
lisp_t *cons(sys_t *, lisp_t *, lisp_t *); lisp_t *cons(sys_t *, lisp_t *, lisp_t *);
lisp_t *make_list(sys_t *, lisp_t **, u64);
lisp_t *make_vec(sys_t *, u64);
lisp_t *make_str(sys_t *, u64);
lisp_t *car(lisp_t *); lisp_t *car(lisp_t *);
lisp_t *cdr(lisp_t *); lisp_t *cdr(lisp_t *);
void lisp_free(lisp_t *); void lisp_free(sys_t *, lisp_t *);
void lisp_free_rec(lisp_t *); void lisp_free_rec(sys_t *, lisp_t *);
#endif #endif

View File

@@ -31,9 +31,12 @@ static_assert(sizeof(vec_t) == 64, "vec_t has to be 64 bytes as part of SBO");
#define VEC_GET(V, I, T) (((T *)vec_data(V))[I]) #define VEC_GET(V, I, T) (((T *)vec_data(V))[I])
#define VEC_SIZE(V, T) ((V)->size / (sizeof(T))) #define VEC_SIZE(V, T) ((V)->size / (sizeof(T)))
#define FOR_VEC(INDEX, V, T) \
for (size_t INDEX = 0; INDEX < VEC_SIZE(V, T); ++INDEX)
void vec_init(vec_t *, u64); void vec_init(vec_t *, u64);
void vec_free(vec_t *); void vec_free(vec_t *);
void vec_reset(vec_t *);
u8 *vec_data(vec_t *); u8 *vec_data(vec_t *);
// Append, possibly reallocating memory // Append, possibly reallocating memory

View File

@@ -23,6 +23,8 @@ alloc_node_t *make_node(page_t *page, tag_t type)
{ {
alloc_node_t *node = NULL; alloc_node_t *node = NULL;
u64 size = sizeof(*node); u64 size = sizeof(*node);
static_assert(NUM_TAGS == 6);
switch (type) switch (type)
{ {
case TAG_CONS: case TAG_CONS:
@@ -31,8 +33,11 @@ alloc_node_t *make_node(page_t *page, tag_t type)
case TAG_VEC: case TAG_VEC:
size += sizeof(vec_t); size += sizeof(vec_t);
break; break;
case TAG_STR:
size += sizeof(str_t);
break;
case TAG_NIL: case TAG_NIL:
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
@@ -52,7 +57,9 @@ alloc_node_t *make_node(page_t *page, tag_t type)
alloc_node_t *lisp_to_node(lisp_t *lisp) alloc_node_t *lisp_to_node(lisp_t *lisp)
{ {
void *raw_ptr = NULL; void *raw_ptr = NULL;
switch (get_tag(lisp))
static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{ {
case TAG_CONS: case TAG_CONS:
raw_ptr = as_cons(lisp); raw_ptr = as_cons(lisp);
@@ -60,8 +67,11 @@ alloc_node_t *lisp_to_node(lisp_t *lisp)
case TAG_VEC: case TAG_VEC:
raw_ptr = as_vec(lisp); raw_ptr = as_vec(lisp);
break; break;
case TAG_STR:
raw_ptr = as_str(lisp);
break;
case TAG_NIL: // These shouldn't be allocated case TAG_NIL: // These shouldn't be allocated
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
@@ -74,13 +84,15 @@ alloc_node_t *lisp_to_node(lisp_t *lisp)
lisp_t *alloc_make(alloc_t *alloc, tag_t type) lisp_t *alloc_make(alloc_t *alloc, tag_t type)
{ {
static_assert(NUM_TAGS == 6);
switch (type) switch (type)
{ {
case TAG_CONS: case TAG_CONS:
case TAG_VEC: case TAG_VEC:
case TAG_STR:
break; break;
case TAG_NIL: // These shouldn't be allocated case TAG_NIL: // These shouldn't be allocated
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
@@ -123,7 +135,7 @@ lisp_t *alloc_make(alloc_t *alloc, tag_t type)
// We couldn't get anything from the free vector, so try to allocate a fresh // We couldn't get anything from the free vector, so try to allocate a fresh
// one against one of the pages. // one against one of the pages.
for (u64 i = 0; i < VEC_SIZE(&alloc->pages, page_t *); ++i) FOR_VEC(i, &alloc->pages, page_t *)
{ {
page_t *page = VEC_GET(&alloc->pages, i, page_t *); page_t *page = VEC_GET(&alloc->pages, i, page_t *);
node = make_node(page, type); node = make_node(page, type);
@@ -146,15 +158,42 @@ end:
void alloc_delete(alloc_t *alloc, lisp_t *lisp) void alloc_delete(alloc_t *alloc, lisp_t *lisp)
{ {
switch (tag_get(lisp))
{
case TAG_CONS:
case TAG_VEC:
case TAG_STR:
break;
case TAG_NIL: // These can't be deleted (not allocated)
case TAG_SMI:
case TAG_SYM:
default:
FAIL("Unreachable");
return;
}
alloc_node_t *node = lisp_to_node(lisp); alloc_node_t *node = lisp_to_node(lisp);
assert(node && node->metadata.references == 0); assert(node && node->metadata.references == 0);
// If already present in the free vector, stop.
FOR_VEC(i, &alloc->free_vec, alloc_node_t *)
{
alloc_node_t *other = VEC_GET(&alloc->pages, i, alloc_node_t *);
if (other == node)
{
return;
}
}
// Otherwise, add to the free vector.
lisp_reset(lisp);
vec_append(&alloc->free_vec, &node, sizeof(node)); vec_append(&alloc->free_vec, &node, sizeof(node));
} }
u64 alloc_cost(alloc_t *alloc) u64 alloc_cost(alloc_t *alloc)
{ {
u64 total_size = alloc->pages.size; u64 total_size = alloc->pages.size;
for (u64 i = 0; i < VEC_SIZE(&alloc->pages, page_t *); ++i) FOR_VEC(i, &alloc->pages, page_t *)
{ {
page_t *page = VEC_GET(&alloc->pages, i, page_t *); page_t *page = VEC_GET(&alloc->pages, i, page_t *);
total_size += page->data.size; total_size += page->data.size;
@@ -164,14 +203,16 @@ u64 alloc_cost(alloc_t *alloc)
void alloc_free(alloc_t *alloc) void alloc_free(alloc_t *alloc)
{ {
for (u64 i = 0; i < VEC_SIZE(&alloc->pages, page_t *); ++i) FOR_VEC(i, &alloc->pages, page_t *)
{ {
page_t *page = VEC_GET(&alloc->pages, i, page_t *); page_t *page = VEC_GET(&alloc->pages, i, page_t *);
// Iterate through every alloc_node in this page // Iterate through every alloc_node in this page (dynamic walk)
for (u64 j = 0; j < VEC_SIZE(&page->data, u8);) for (u64 j = 0; j < VEC_SIZE(&page->data, u8);)
{ {
alloc_node_t *node = (alloc_node_t *)(vec_data(&page->data) + j); alloc_node_t *node = (alloc_node_t *)(vec_data(&page->data) + j);
u64 next = sizeof(*node) + tag_sizeof(node->metadata.tag); u64 next = sizeof(*node) + tag_sizeof(node->metadata.tag);
static_assert(NUM_TAGS == 6);
switch (node->metadata.tag) switch (node->metadata.tag)
{ {
case TAG_CONS: case TAG_CONS:
@@ -180,8 +221,11 @@ void alloc_free(alloc_t *alloc)
case TAG_VEC: case TAG_VEC:
vec_free((vec_t *)node->data); vec_free((vec_t *)node->data);
break; break;
case TAG_STR:
vec_free(&((str_t *)node->data)->data);
break;
case TAG_NIL: case TAG_NIL:
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
default: default:
FAIL("Unreachable"); FAIL("Unreachable");

View File

@@ -10,98 +10,107 @@
#include <alisp/lisp.h> #include <alisp/lisp.h>
lisp_t *tag_int(i64 i) lisp_t *tag_smi(i64 i)
{ {
return TAG((u64)i, INT); return TAG(i, SMI);
} }
lisp_t *tag_sym(const char *str) lisp_t *tag_sym(const char *str)
{ {
return TAG((u64)str, SYM); return TAG(str, SYM);
} }
lisp_t *tag_vec(const vec_t *vec) lisp_t *tag_vec(const vec_t *vec)
{ {
return TAG((u64)vec, VEC); return TAG(vec, VEC);
}
lisp_t *tag_str(const str_t *str)
{
return TAG(str, STR);
} }
lisp_t *tag_cons(const cons_t *cons) lisp_t *tag_cons(const cons_t *cons)
{ {
return TAG((u64)cons, CONS); return TAG(cons, CONS);
} }
lisp_t *tag_generic(void *ptr, tag_t type) lisp_t *tag_generic(void *ptr, tag_t type)
{ {
static_assert(NUM_TAGS == 6);
switch (type) switch (type)
{ {
case TAG_NIL: case TAG_NIL:
return NIL; return TAG(ptr, NIL);
case TAG_INT: case TAG_SMI:
return tag_int((i64)ptr); return tag_smi((i64)ptr);
case TAG_SYM: case TAG_SYM:
return tag_sym(ptr); return tag_sym(ptr);
case TAG_CONS: case TAG_CONS:
return tag_cons(ptr); return tag_cons(ptr);
case TAG_VEC: case TAG_VEC:
return tag_vec(ptr); return tag_vec(ptr);
case TAG_STR:
return tag_str(ptr);
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
return NIL; return NIL;
} }
} }
tag_t get_tag(const lisp_t *lisp) tag_t tag_get(const lisp_t *lisp)
{ {
static_assert(NUM_TAGS == 5); return GET_TAG(lisp);
if (!lisp)
return TAG_NIL;
else if (IS_TAG(lisp, INT))
return TAG_INT;
return (u64)lisp & 0xFF;
} }
i64 as_int(lisp_t *obj) i64 as_smi(lisp_t *obj)
{ {
assert(IS_TAG(obj, INT)); assert(IS_TAG(obj, SMI));
u64 p_obj = (u64)obj; u64 raw_obj = UNTAG(obj);
return UNTAG(p_obj, INT) | // Delete the tag u64 msb = (NTH_BYTE(raw_obj, 6) & 0x80) >> 7;
(NTH_BYTE(p_obj, 7) & 0x80) << 56 // duplicate the MSB (preserve sign) msb = ((1LU << 8) - msb) << 56;
; return (i64)(raw_obj | msb);
} }
char *as_sym(lisp_t *obj) char *as_sym(lisp_t *obj)
{ {
assert(IS_TAG(obj, SYM)); assert(IS_TAG(obj, SYM));
return (char *)UNTAG(obj, SYM); return (char *)UNTAG(obj);
} }
cons_t *as_cons(lisp_t *obj) cons_t *as_cons(lisp_t *obj)
{ {
assert(IS_TAG(obj, CONS)); assert(IS_TAG(obj, CONS));
return (cons_t *)UNTAG(obj, CONS); return (cons_t *)UNTAG(obj);
}
str_t *as_str(lisp_t *obj)
{
assert(IS_TAG(obj, STR));
return (str_t *)UNTAG(obj);
} }
vec_t *as_vec(lisp_t *obj) vec_t *as_vec(lisp_t *obj)
{ {
assert(IS_TAG(obj, VEC)); assert(IS_TAG(obj, VEC));
return (vec_t *)UNTAG(obj, VEC); return (vec_t *)UNTAG(obj);
} }
void lisp_print(FILE *fp, lisp_t *lisp) void lisp_print(FILE *fp, lisp_t *lisp)
{ {
if (!fp) if (!fp)
return; return;
switch (get_tag(lisp)) static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{ {
case TAG_NIL: case TAG_NIL:
fprintf(fp, "NIL"); fprintf(fp, "NIL");
break; break;
case TAG_INT: case TAG_SMI:
#if VERBOSE_LOGS == 2 #if VERBOSE_LOGS == 2
fprintf(fp, "INT["); fprintf(fp, "INT[");
#endif #endif
fprintf(fp, "%ld", as_int(lisp)); fprintf(fp, "%ld", as_smi(lisp));
#if VERBOSE_LOGS == 2 #if VERBOSE_LOGS == 2
fprintf(fp, "]"); fprintf(fp, "]");
#endif #endif
@@ -161,11 +170,11 @@ void lisp_print(FILE *fp, lisp_t *lisp)
#endif #endif
vec_t *vec = as_vec(lisp); vec_t *vec = as_vec(lisp);
for (u64 i = 1; i <= VEC_SIZE(vec, lisp_t *); ++i) FOR_VEC(i, vec, lisp_t *)
{ {
lisp_t *item = VEC_GET(vec, i - 1, lisp_t *); lisp_t *item = VEC_GET(vec, i, lisp_t *);
lisp_print(fp, item); lisp_print(fp, item);
if (i != VEC_SIZE(vec, lisp_t *)) if (i < VEC_SIZE(vec, lisp_t *) - 1)
{ {
fprintf(fp, " "); fprintf(fp, " ");
} }
@@ -178,7 +187,24 @@ void lisp_print(FILE *fp, lisp_t *lisp)
#endif #endif
break; break;
} }
case NUM_TAGS: case TAG_STR:
{
#if VERBOSE_LOGS == 2
fprintf(fp, "STR[");
#else
fprintf(fp, "\"");
#endif
sv_t sv = string_sv(as_str(lisp));
fprintf(fp, PR_SV, SV_FMT(sv));
#if VERBOSE_LOGS == 2
fprintf(fp, "]");
#else
fprintf(fp, "\"");
#endif
break;
}
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
break; break;
@@ -187,18 +213,20 @@ void lisp_print(FILE *fp, lisp_t *lisp)
u64 tag_sizeof(tag_t tag) u64 tag_sizeof(tag_t tag)
{ {
static_assert(NUM_TAGS == 6);
switch (tag) switch (tag)
{ {
case TAG_NIL: case TAG_NIL:
return 0; return 0;
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
return sizeof(lisp_t *); return sizeof(lisp_t *);
case TAG_CONS: case TAG_CONS:
return sizeof(cons_t); return sizeof(cons_t);
case TAG_VEC: case TAG_VEC:
return sizeof(vec_t); return sizeof(vec_t);
case NUM_TAGS: case TAG_STR:
return sizeof(str_t);
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
return 0; return 0;
@@ -207,7 +235,41 @@ u64 tag_sizeof(tag_t tag)
u64 lisp_sizeof(lisp_t *lisp) u64 lisp_sizeof(lisp_t *lisp)
{ {
return tag_sizeof(get_tag(lisp)); return tag_sizeof(tag_get(lisp));
}
lisp_t *lisp_reset(lisp_t *lisp)
{
switch (tag_get(lisp))
{
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
// Nothing to "reset" here.
return lisp;
case TAG_CONS:
{
// Make `car` and `cons` NIL
CAR(lisp) = NIL;
CDR(lisp) = NIL;
return lisp;
}
case TAG_VEC:
{
vec_reset(as_vec(lisp));
return lisp;
}
case TAG_STR:
{
vec_reset(&as_str(lisp)->data);
return lisp;
}
default:
{
FAIL("Unreachable");
return lisp;
}
}
} }
/* Copyright (C) 2025, 2026 Aryadev Chavali /* Copyright (C) 2025, 2026 Aryadev Chavali

View File

@@ -45,10 +45,10 @@ int main(int argc, char *argv[])
VEC_SIZE(&ast, lisp_t *) == 1 ? "expr" : "exprs"); VEC_SIZE(&ast, lisp_t *) == 1 ? "expr" : "exprs");
{ {
for (u64 i = 0; i < VEC_SIZE(&ast, lisp_t *); ++i) FOR_VEC(i, &ast, lisp_t *)
{ {
lisp_t *expr = VEC_GET(&ast, i, lisp_t *);
#if VERBOSE_LOGS #if VERBOSE_LOGS
lisp_t *expr = VEC_GET(&ast, i, lisp_t *);
printf("\t[%lu]: ", i); printf("\t[%lu]: ", i);
lisp_print(stdout, expr); lisp_print(stdout, expr);
printf("\n"); printf("\n");

View File

@@ -20,11 +20,12 @@ const char *read_err_to_cstr(read_err_t err)
return "EOF"; return "EOF";
case READ_ERR_UNKNOWN_CHAR: case READ_ERR_UNKNOWN_CHAR:
return "UNKNOWN_CHAR"; return "UNKNOWN_CHAR";
break;
case READ_ERR_EXPECTED_CLOSED_BRACE: case READ_ERR_EXPECTED_CLOSED_BRACE:
return "EXPECTED_CLOSED_BRACE"; return "EXPECTED_CLOSED_BRACE";
case READ_ERR_EXPECTED_CLOSED_SQUARE_BRACKET: case READ_ERR_EXPECTED_CLOSED_SQUARE_BRACKET:
return "EXPECTED_CLOSED_SQUARE_BRACKET"; return "EXPECTED_CLOSED_SQUARE_BRACKET";
case READ_ERR_EXPECTED_CLOSING_SPEECHMARKS:
return "EXPECTED_CLOSING_SPEECHMARKS";
case READ_ERR_UNEXPECTED_CLOSED_BRACE: case READ_ERR_UNEXPECTED_CLOSED_BRACE:
return "UNEXPECTED_CLOSED_BRACE"; return "UNEXPECTED_CLOSED_BRACE";
case READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET: case READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET:
@@ -37,7 +38,7 @@ const char *read_err_to_cstr(read_err_t err)
// Accepted characters for symbols. // Accepted characters for symbols.
static const char *SYMBOL_CHARS = static const char *SYMBOL_CHARS =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!$%&*+,-./" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!$%&*+,-./"
":<=>?@\\^_`{|}~0123456789"; ":<=>?@\\^_{|}~0123456789";
// Little predicate using SYMBOL_CHARS // Little predicate using SYMBOL_CHARS
bool is_sym(char c) bool is_sym(char c)
@@ -76,9 +77,9 @@ read_err_t read_int(sys_t *sys, stream_t *stream, lisp_t **ret)
return read_sym(sys, stream, ret); return read_sym(sys, stream, ret);
} }
if (digits_sv.size > 19) if (digits_sv.size >= 18)
{ {
TODO("alisp doesn't support big integers (bigger than 63 bits) yet"); TODO("alisp doesn't support big integers (bigger than 56 bits) yet");
} }
i64 n = 0; i64 n = 0;
@@ -92,7 +93,7 @@ read_err_t read_int(sys_t *sys, stream_t *stream, lisp_t **ret)
// => i > (INT_MAX - digit) / 10 // => i > (INT_MAX - digit) / 10
if (n > (INT_MAX - digit) / 10) if (n > (INT_MAX - digit) / 10)
{ {
TODO("alisp doesn't support big integers (bigger than 63 bits) yet"); TODO("alisp doesn't support big integers (bigger than 56 bits) yet");
} }
n *= 10; n *= 10;
@@ -111,9 +112,7 @@ read_err_t read_negative(sys_t *sys, stream_t *stream, lisp_t **ret)
read_err_t err = read_int(sys, stream, ret); read_err_t err = read_int(sys, stream, ret);
if (err) if (err)
return err; return err;
i64 n = as_int(*ret); *ret = make_int(as_smi(*ret) * -1);
n *= -1;
*ret = make_int(n);
return READ_ERR_OK; return READ_ERR_OK;
} }
else if (is_sym(c) || isspace(c)) else if (is_sym(c) || isspace(c))
@@ -122,11 +121,14 @@ read_err_t read_negative(sys_t *sys, stream_t *stream, lisp_t **ret)
return read_sym(sys, stream, ret); return read_sym(sys, stream, ret);
} }
else else
{
return READ_ERR_UNKNOWN_CHAR; return READ_ERR_UNKNOWN_CHAR;
}
} }
read_err_t read_list(sys_t *sys, stream_t *stream, lisp_t **ret) read_err_t read_list(sys_t *sys, stream_t *stream, lisp_t **ret)
{ {
u64 old_pos = stream->position;
// skip past the open parentheses '(' // skip past the open parentheses '('
(void)stream_next(stream); (void)stream_next(stream);
@@ -138,7 +140,7 @@ read_err_t read_list(sys_t *sys, stream_t *stream, lisp_t **ret)
read_err_t err = read(sys, stream, &item); read_err_t err = read(sys, stream, &item);
if (err == READ_ERR_EOF) if (err == READ_ERR_EOF)
{ {
return READ_ERR_EXPECTED_CLOSED_BRACE; goto no_close_brace;
} }
else if (err) else if (err)
{ {
@@ -157,16 +159,23 @@ read_err_t read_list(sys_t *sys, stream_t *stream, lisp_t **ret)
} }
if (stream_peek(stream) != ')') if (stream_peek(stream) != ')')
return READ_ERR_EXPECTED_CLOSED_BRACE; {
goto no_close_brace;
}
stream_next(stream); stream_next(stream);
*ret = top; *ret = top;
return READ_ERR_OK; return READ_ERR_OK;
no_close_brace:
stream->position = old_pos;
return READ_ERR_EXPECTED_CLOSED_BRACE;
} }
read_err_t read_vec(sys_t *sys, stream_t *stream, lisp_t **ret) read_err_t read_vec(sys_t *sys, stream_t *stream, lisp_t **ret)
{ {
u64 old_pos = stream->position;
(void)stream_next(stream); (void)stream_next(stream);
lisp_t *container = make_vec(sys, 0); lisp_t *container = make_vec(sys, 0);
while (!stream_eoc(stream) && stream_peek(stream) != ']') while (!stream_eoc(stream) && stream_peek(stream) != ']')
{ {
@@ -174,7 +183,7 @@ read_err_t read_vec(sys_t *sys, stream_t *stream, lisp_t **ret)
read_err_t err = read(sys, stream, &item); read_err_t err = read(sys, stream, &item);
if (err == READ_ERR_EOF) if (err == READ_ERR_EOF)
{ {
return READ_ERR_EXPECTED_CLOSED_BRACE; goto no_close_square_bracket;
} }
else if (err) else if (err)
{ {
@@ -187,10 +196,33 @@ read_err_t read_vec(sys_t *sys, stream_t *stream, lisp_t **ret)
} }
if (stream_peek(stream) != ']') if (stream_peek(stream) != ']')
return READ_ERR_EXPECTED_CLOSED_SQUARE_BRACKET; goto no_close_square_bracket;
stream_next(stream); stream_next(stream);
*ret = container; *ret = container;
return READ_ERR_OK; return READ_ERR_OK;
no_close_square_bracket:
stream->position = old_pos;
return READ_ERR_EXPECTED_CLOSED_SQUARE_BRACKET;
}
read_err_t read_str(sys_t *sys, stream_t *stream, lisp_t **ret)
{
u64 old_pos = stream->position;
(void)stream_next(stream);
sv_t contents = stream_till(stream, "\"");
if (stream_eoc(stream) || stream_peek(stream) != '\"')
{
stream->position = old_pos;
return READ_ERR_EXPECTED_CLOSING_SPEECHMARKS;
}
stream_next(stream);
lisp_t *lisp = make_str(sys, contents.size);
vec_append(&as_str(lisp)->data, contents.data, contents.size);
*ret = lisp;
return READ_ERR_OK;
} }
read_err_t read_quote(sys_t *sys, stream_t *stream, lisp_t **ret) read_err_t read_quote(sys_t *sys, stream_t *stream, lisp_t **ret)
@@ -200,8 +232,8 @@ read_err_t read_quote(sys_t *sys, stream_t *stream, lisp_t **ret)
read_err_t err = read(sys, stream, &to_quote); read_err_t err = read(sys, stream, &to_quote);
if (err) if (err)
return err; return err;
*ret = cons(sys, to_quote, NIL); lisp_t *items[] = {intern(sys, SV_AUTO("quote")), to_quote};
*ret = cons(sys, intern(sys, SV_AUTO("quote")), *ret); *ret = make_list(sys, items, ARRSIZE(items));
return READ_ERR_OK; return READ_ERR_OK;
} }
@@ -243,6 +275,8 @@ read_err_t read(sys_t *sys, stream_t *stream, lisp_t **ret)
return read_vec(sys, stream, ret); return read_vec(sys, stream, ret);
else if (c == ']') else if (c == ']')
return READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET; return READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET;
else if (c == '\"')
return read_str(sys, stream, ret);
return READ_ERR_UNKNOWN_CHAR; return READ_ERR_UNKNOWN_CHAR;
} }

44
src/string.c Normal file
View File

@@ -0,0 +1,44 @@
/* string.c: String library implementation
* Created: 2026-03-05
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include <string.h>
#include <alisp/string.h>
str_t string_make(sv_t sv)
{
str_t string = {0};
if (sv.size)
{
vec_init(&string.data, sv.size);
if (sv.data)
{
memcpy(vec_data(&string.data), sv.data, sv.size);
}
}
return string;
}
sv_t string_sv(str_t *str)
{
if (!str)
return SV(NULL, 0);
return SV((char *)vec_data(&str->data), str->data.size);
}
/* Copyright (C) 2026 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/>.
*/

View File

@@ -17,14 +17,16 @@ void sys_init(sys_t *sys)
lisp_t *sys_alloc(sys_t *sys, tag_t type) lisp_t *sys_alloc(sys_t *sys, tag_t type)
{ {
static_assert(NUM_TAGS == 6);
switch (type) switch (type)
{ {
case TAG_CONS: case TAG_CONS:
case TAG_VEC: case TAG_VEC:
case TAG_STR:
return alloc_make(&sys->memory, type); return alloc_make(&sys->memory, type);
// Shouldn't be allocated // Shouldn't be allocated
case TAG_NIL: case TAG_NIL:
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
@@ -32,6 +34,11 @@ lisp_t *sys_alloc(sys_t *sys, tag_t type)
return NIL; return NIL;
} }
void sys_delete(sys_t *sys, lisp_t *lisp)
{
alloc_delete(&sys->memory, lisp);
}
u64 sys_cost(sys_t *sys) u64 sys_cost(sys_t *sys)
{ {
return alloc_cost(&sys->memory) + sym_table_cost(&sys->symtable); return alloc_cost(&sys->memory) + sym_table_cost(&sys->symtable);
@@ -46,7 +53,7 @@ void sys_free(sys_t *sys)
lisp_t *make_int(i64 i) lisp_t *make_int(i64 i)
{ {
return tag_int(i); return tag_smi(i);
} }
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr) lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
@@ -57,6 +64,17 @@ lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
return cons; return cons;
} }
lisp_t *make_list(sys_t *sys, lisp_t **lisps, u64 size)
{
lisp_t *root = NIL;
for (u64 i = size; i > 0; --i)
{
lisp_t *node = lisps[i - 1];
root = cons(sys, node, root);
}
return root;
}
lisp_t *make_vec(sys_t *sys, u64 capacity) lisp_t *make_vec(sys_t *sys, u64 capacity)
{ {
lisp_t *vec = sys_alloc(sys, TAG_VEC); lisp_t *vec = sys_alloc(sys, TAG_VEC);
@@ -64,6 +82,13 @@ lisp_t *make_vec(sys_t *sys, u64 capacity)
return vec; return vec;
} }
lisp_t *make_str(sys_t *sys, u64 capacity)
{
lisp_t *str = sys_alloc(sys, TAG_STR);
vec_init(&as_str(str)->data, capacity);
return str;
}
lisp_t *intern(sys_t *sys, sv_t sv) lisp_t *intern(sys_t *sys, sv_t sv)
{ {
const char *str = sym_table_find(&sys->symtable, sv); const char *str = sym_table_find(&sys->symtable, sv);
@@ -86,57 +111,56 @@ lisp_t *cdr(lisp_t *lsp)
return CDR(lsp); return CDR(lsp);
} }
void lisp_free(lisp_t *item) void lisp_free(sys_t *sys, lisp_t *lisp)
{ {
switch (get_tag(item)) static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{ {
case TAG_CONS: case TAG_STR:
// Delete the cons
free(as_cons(item));
break;
case TAG_VEC: case TAG_VEC:
{ case TAG_CONS:
vec_t *vec = as_vec(item); // Delete the underlying data
vec_free(vec); alloc_delete(&sys->memory, lisp);
free(vec);
break; break;
}
case TAG_NIL: case TAG_NIL:
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
case NUM_TAGS:
// shouldn't be dealt with (either constant or dealt with elsewhere) // shouldn't be dealt with (either constant or dealt with elsewhere)
break; break;
} }
} }
void lisp_free_rec(lisp_t *item) void lisp_free_rec(sys_t *sys, lisp_t *item)
{ {
switch (get_tag(item)) static_assert(NUM_TAGS == 6);
switch (tag_get(item))
{ {
case TAG_CONS: case TAG_CONS:
{ {
lisp_free_rec(car(item)); lisp_free_rec(sys, car(item));
lisp_free_rec(cdr(item)); lisp_free_rec(sys, cdr(item));
free(as_cons(item)); lisp_free(sys, item);
break; break;
} }
case TAG_VEC: case TAG_VEC:
{ {
vec_t *vec = as_vec(item); vec_t *vec = as_vec(item);
for (size_t i = 0; i < VEC_SIZE(vec, lisp_t **); ++i) FOR_VEC(i, vec, lisp_t *)
{ {
lisp_t *allocated = VEC_GET(vec, i, lisp_t *); lisp_t *allocated = VEC_GET(vec, i, lisp_t *);
lisp_free_rec(allocated); lisp_free_rec(sys, allocated);
} }
vec_free(vec); lisp_free(sys, item);
free(vec); break;
}
case TAG_STR:
{
lisp_free(sys, item);
break; break;
} }
case TAG_NIL: case TAG_NIL:
case TAG_INT: case TAG_SMI:
case TAG_SYM: case TAG_SYM:
case NUM_TAGS:
// shouldn't be dealt with (either constant or dealt with elsewhere) // shouldn't be dealt with (either constant or dealt with elsewhere)
break; break;
} }

View File

@@ -38,6 +38,14 @@ void vec_free(vec_t *vec)
memset(vec, 0, sizeof(*vec)); memset(vec, 0, sizeof(*vec));
} }
void vec_reset(vec_t *vec)
{
if (!vec)
return;
memset(vec_data(vec), 0, vec->capacity);
vec->size = 0;
}
u8 *vec_data(vec_t *vec) u8 *vec_data(vec_t *vec)
{ {
return vec->not_inlined ? vec->ptr : vec->inlined; return vec->not_inlined ? vec->ptr : vec->inlined;

View File

@@ -23,7 +23,7 @@ void smi_test(void)
{ {
i64 in = ints[i]; i64 in = ints[i];
lisp_t *lisp = make_int(in); lisp_t *lisp = make_int(in);
i64 out = as_int(lisp); i64 out = as_smi(lisp);
TEST(in == out, "%ld == %ld", in, out); TEST(in == out, "%ld == %ld", in, out);
} }
@@ -47,7 +47,7 @@ void smi_oob_test(void)
{ {
i64 in = ints[i]; i64 in = ints[i];
lisp_t *lisp = make_int(in); lisp_t *lisp = make_int(in);
i64 out = as_int(lisp); i64 out = as_smi(lisp);
TEST(in != out, "%ld != %ld", in, out); TEST(in != out, "%ld != %ld", in, out);
} }