lisp: split lisp into lisp and sys
Generic definition of tagged pointers, along with simple constructor/destructors should be in lisp.h for use by other headers. sys.h on the other hand contains all the general system methods.
This commit is contained in:
2
Makefile
2
Makefile
@@ -19,7 +19,7 @@ CFLAGS=$(GFLAGS) $(DFLAGS) -DTEST_VERBOSE=1
|
||||
endif
|
||||
|
||||
# Units to compile
|
||||
UNITS=src/sv.c src/vec.c src/stream.c src/symtable.c src/tag.c src/lisp.c src/reader.c
|
||||
UNITS=src/sv.c src/vec.c src/stream.c src/symtable.c src/lisp.c src/sys.c src/reader.c
|
||||
OBJECTS:=$(patsubst src/%.c, $(DIST)/%.o, $(UNITS))
|
||||
|
||||
TEST_UNITS=test/main.c
|
||||
|
||||
@@ -66,33 +66,6 @@ lisp_t *tag_sym(const char *);
|
||||
lisp_t *tag_cons(const cons_t *);
|
||||
lisp_t *tag_vec(const vec_t *);
|
||||
|
||||
/// System context
|
||||
typedef struct
|
||||
{
|
||||
vec_t conses;
|
||||
vec_t vectors;
|
||||
u64 num_conses, num_vectors;
|
||||
} sys_mem_t;
|
||||
|
||||
typedef struct
|
||||
{
|
||||
sys_mem_t memory;
|
||||
sym_table_t symtable;
|
||||
} sys_t;
|
||||
|
||||
void sys_init(sys_t *);
|
||||
lisp_t *sys_alloc(sys_t *, tag_t type);
|
||||
void sys_free(sys_t *);
|
||||
|
||||
// Debugging function: provides total memory usage from system.
|
||||
u64 sys_cost(sys_t *);
|
||||
|
||||
/// Constructors and destructors
|
||||
lisp_t *make_int(i64);
|
||||
lisp_t *make_vec(sys_t *, u64);
|
||||
lisp_t *intern(sys_t *, sv_t);
|
||||
lisp_t *cons(sys_t *, lisp_t *, lisp_t *);
|
||||
|
||||
i64 as_int(lisp_t *);
|
||||
char *as_sym(lisp_t *);
|
||||
cons_t *as_cons(lisp_t *);
|
||||
@@ -101,12 +74,6 @@ vec_t *as_vec(lisp_t *);
|
||||
#define CAR(L) (as_cons(L)->car)
|
||||
#define CDR(L) (as_cons(L)->cdr)
|
||||
|
||||
lisp_t *car(lisp_t *);
|
||||
lisp_t *cdr(lisp_t *);
|
||||
|
||||
void lisp_free(lisp_t *);
|
||||
void lisp_free_rec(lisp_t *);
|
||||
|
||||
void lisp_print(FILE *, lisp_t *);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -8,8 +8,8 @@
|
||||
#ifndef READER_H
|
||||
#define READER_H
|
||||
|
||||
#include <alisp/lisp.h>
|
||||
#include <alisp/stream.h>
|
||||
#include <alisp/sys.h>
|
||||
|
||||
typedef enum
|
||||
{
|
||||
|
||||
59
include/alisp/sys.h
Normal file
59
include/alisp/sys.h
Normal file
@@ -0,0 +1,59 @@
|
||||
/* sys.h: System context and constructors
|
||||
* Created: 2026-02-12
|
||||
* Author: Aryadev Chavali
|
||||
* License: See end of file
|
||||
* Commentary:
|
||||
*/
|
||||
|
||||
#ifndef SYS_H
|
||||
#define SYS_H
|
||||
|
||||
#include <alisp/lisp.h>
|
||||
|
||||
/// System context
|
||||
typedef struct
|
||||
{
|
||||
vec_t conses;
|
||||
vec_t vectors;
|
||||
u64 num_conses, num_vectors;
|
||||
} sys_mem_t;
|
||||
|
||||
typedef struct
|
||||
{
|
||||
sys_mem_t memory;
|
||||
sym_table_t symtable;
|
||||
} sys_t;
|
||||
|
||||
void sys_init(sys_t *);
|
||||
lisp_t *sys_alloc(sys_t *, tag_t type);
|
||||
void sys_free(sys_t *);
|
||||
|
||||
// Debugging function: provides total memory usage from system.
|
||||
u64 sys_cost(sys_t *);
|
||||
|
||||
/// Constructors and general Lisp API
|
||||
lisp_t *make_int(i64);
|
||||
lisp_t *make_vec(sys_t *, u64);
|
||||
lisp_t *intern(sys_t *, sv_t);
|
||||
lisp_t *cons(sys_t *, lisp_t *, lisp_t *);
|
||||
|
||||
lisp_t *car(lisp_t *);
|
||||
lisp_t *cdr(lisp_t *);
|
||||
|
||||
void lisp_free(lisp_t *);
|
||||
void lisp_free_rec(lisp_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/>.
|
||||
|
||||
*/
|
||||
175
src/lisp.c
175
src/lisp.c
@@ -10,175 +10,62 @@
|
||||
|
||||
#include <alisp/lisp.h>
|
||||
|
||||
void sys_init(sys_t *sys)
|
||||
lisp_t *tag_int(i64 i)
|
||||
{
|
||||
memset(sys, 0, sizeof(*sys));
|
||||
return TAG((u64)i, INT);
|
||||
}
|
||||
|
||||
lisp_t *sys_alloc(sys_t *sys, tag_t type)
|
||||
lisp_t *tag_sym(const char *str)
|
||||
{
|
||||
switch (type)
|
||||
{
|
||||
case TAG_CONS:
|
||||
{
|
||||
cons_t *cons = calloc(1, sizeof(*cons));
|
||||
lisp_t *lisp = tag_cons(cons);
|
||||
vec_append(&sys->memory.conses, &lisp, sizeof(&lisp));
|
||||
sys->memory.num_conses++;
|
||||
return lisp;
|
||||
}
|
||||
case TAG_VEC:
|
||||
{
|
||||
vec_t *vec = calloc(1, sizeof(*vec));
|
||||
lisp_t *lisp = tag_vec(vec);
|
||||
vec_append(&sys->memory.vectors, &lisp, sizeof(&lisp));
|
||||
sys->memory.num_vectors++;
|
||||
return lisp;
|
||||
}
|
||||
// Shouldn't be registered
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SYM:
|
||||
default:
|
||||
FAIL("Unreachable");
|
||||
}
|
||||
return NIL;
|
||||
return TAG((u64)str, SYM);
|
||||
}
|
||||
|
||||
u64 sys_cost(sys_t *sys)
|
||||
lisp_t *tag_vec(const vec_t *vec)
|
||||
{
|
||||
u64 vec_capacity = 0;
|
||||
for (u64 i = 0; i < sys->memory.num_vectors; ++i)
|
||||
{
|
||||
lisp_t *vec = VEC_GET(&sys->memory.vectors, i, lisp_t *);
|
||||
vec_capacity += as_vec(vec)->capacity;
|
||||
}
|
||||
return sym_table_cost(&sys->symtable) +
|
||||
(sys->memory.num_conses * sizeof(cons_t)) + vec_capacity;
|
||||
return TAG((u64)vec, VEC);
|
||||
}
|
||||
|
||||
void sys_free(sys_t *sys)
|
||||
lisp_t *tag_cons(const cons_t *cons)
|
||||
{
|
||||
sym_table_free(&sys->symtable);
|
||||
|
||||
// Iterate through each cell of memory currently allocated and free them
|
||||
for (size_t i = 0; i < VEC_SIZE(&sys->memory.conses, lisp_t **); ++i)
|
||||
{
|
||||
lisp_t *allocated = VEC_GET(&sys->memory.conses, i, lisp_t *);
|
||||
lisp_free(allocated);
|
||||
}
|
||||
|
||||
// Iterate through each cell of memory currently allocated and free them
|
||||
for (size_t i = 0; i < VEC_SIZE(&sys->memory.vectors, lisp_t **); ++i)
|
||||
{
|
||||
lisp_t *allocated = VEC_GET(&sys->memory.vectors, i, lisp_t *);
|
||||
lisp_free(allocated);
|
||||
}
|
||||
|
||||
// Free the containers
|
||||
vec_free(&sys->memory.conses);
|
||||
vec_free(&sys->memory.vectors);
|
||||
|
||||
// Ensure no one treats this as active in any sense
|
||||
memset(sys, 0, sizeof(*sys));
|
||||
return TAG((u64)cons, CONS);
|
||||
}
|
||||
|
||||
lisp_t *make_int(i64 i)
|
||||
tag_t get_tag(const lisp_t *lisp)
|
||||
{
|
||||
return tag_int(i);
|
||||
static_assert(NUM_TAGS == 5);
|
||||
if (!lisp)
|
||||
return TAG_NIL;
|
||||
else if (IS_TAG(lisp, INT))
|
||||
return TAG_INT;
|
||||
|
||||
return (u64)lisp & 0xFF;
|
||||
}
|
||||
|
||||
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
|
||||
i64 as_int(lisp_t *obj)
|
||||
{
|
||||
lisp_t *cons = sys_alloc(sys, TAG_CONS);
|
||||
CAR(cons) = car;
|
||||
CDR(cons) = cdr;
|
||||
return cons;
|
||||
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)
|
||||
;
|
||||
}
|
||||
|
||||
lisp_t *make_vec(sys_t *sys, u64 capacity)
|
||||
char *as_sym(lisp_t *obj)
|
||||
{
|
||||
lisp_t *vec = sys_alloc(sys, TAG_VEC);
|
||||
vec_init(as_vec(vec), capacity);
|
||||
return vec;
|
||||
assert(IS_TAG(obj, SYM));
|
||||
return (char *)UNTAG(obj, SYM);
|
||||
}
|
||||
|
||||
lisp_t *intern(sys_t *sys, sv_t sv)
|
||||
cons_t *as_cons(lisp_t *obj)
|
||||
{
|
||||
const char *str = sym_table_find(&sys->symtable, sv);
|
||||
return tag_sym(str);
|
||||
assert(IS_TAG(obj, CONS));
|
||||
return (cons_t *)UNTAG(obj, CONS);
|
||||
}
|
||||
|
||||
lisp_t *car(lisp_t *lsp)
|
||||
vec_t *as_vec(lisp_t *obj)
|
||||
{
|
||||
if (!IS_TAG(lsp, CONS))
|
||||
return NIL;
|
||||
else
|
||||
return CAR(lsp);
|
||||
}
|
||||
|
||||
lisp_t *cdr(lisp_t *lsp)
|
||||
{
|
||||
if (!IS_TAG(lsp, CONS))
|
||||
return NIL;
|
||||
else
|
||||
return CDR(lsp);
|
||||
}
|
||||
|
||||
void lisp_free(lisp_t *item)
|
||||
{
|
||||
switch (get_tag(item))
|
||||
{
|
||||
case TAG_CONS:
|
||||
// Delete the cons
|
||||
free(as_cons(item));
|
||||
break;
|
||||
case TAG_VEC:
|
||||
{
|
||||
vec_t *vec = as_vec(item);
|
||||
vec_free(vec);
|
||||
free(vec);
|
||||
break;
|
||||
}
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SYM:
|
||||
case NUM_TAGS:
|
||||
// shouldn't be dealt with (either constant or dealt with elsewhere)
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
void lisp_free_rec(lisp_t *item)
|
||||
{
|
||||
switch (get_tag(item))
|
||||
{
|
||||
case TAG_CONS:
|
||||
{
|
||||
lisp_free_rec(car(item));
|
||||
lisp_free_rec(cdr(item));
|
||||
free(as_cons(item));
|
||||
break;
|
||||
}
|
||||
case TAG_VEC:
|
||||
{
|
||||
vec_t *vec = as_vec(item);
|
||||
for (size_t i = 0; i < VEC_SIZE(vec, lisp_t **); ++i)
|
||||
{
|
||||
lisp_t *allocated = VEC_GET(vec, i, lisp_t *);
|
||||
lisp_free_rec(allocated);
|
||||
}
|
||||
vec_free(vec);
|
||||
free(vec);
|
||||
break;
|
||||
}
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SYM:
|
||||
case NUM_TAGS:
|
||||
// shouldn't be dealt with (either constant or dealt with elsewhere)
|
||||
break;
|
||||
}
|
||||
assert(IS_TAG(obj, VEC));
|
||||
return (vec_t *)UNTAG(obj, VEC);
|
||||
}
|
||||
|
||||
void lisp_print(FILE *fp, lisp_t *lisp)
|
||||
|
||||
195
src/sys.c
Normal file
195
src/sys.c
Normal file
@@ -0,0 +1,195 @@
|
||||
/* sys.c: System implementation
|
||||
* Created: 2026-02-12
|
||||
* Author: Aryadev Chavali
|
||||
* License: See end of file
|
||||
* Commentary:
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <alisp/sys.h>
|
||||
|
||||
void sys_init(sys_t *sys)
|
||||
{
|
||||
memset(sys, 0, sizeof(*sys));
|
||||
}
|
||||
|
||||
lisp_t *sys_alloc(sys_t *sys, tag_t type)
|
||||
{
|
||||
switch (type)
|
||||
{
|
||||
case TAG_CONS:
|
||||
{
|
||||
cons_t *cons = calloc(1, sizeof(*cons));
|
||||
lisp_t *lisp = tag_cons(cons);
|
||||
vec_append(&sys->memory.conses, &lisp, sizeof(&lisp));
|
||||
sys->memory.num_conses++;
|
||||
return lisp;
|
||||
}
|
||||
case TAG_VEC:
|
||||
{
|
||||
vec_t *vec = calloc(1, sizeof(*vec));
|
||||
lisp_t *lisp = tag_vec(vec);
|
||||
vec_append(&sys->memory.vectors, &lisp, sizeof(&lisp));
|
||||
sys->memory.num_vectors++;
|
||||
return lisp;
|
||||
}
|
||||
// Shouldn't be registered
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SYM:
|
||||
default:
|
||||
FAIL("Unreachable");
|
||||
}
|
||||
return NIL;
|
||||
}
|
||||
|
||||
u64 sys_cost(sys_t *sys)
|
||||
{
|
||||
u64 vec_capacity = 0;
|
||||
for (u64 i = 0; i < sys->memory.num_vectors; ++i)
|
||||
{
|
||||
lisp_t *vec = VEC_GET(&sys->memory.vectors, i, lisp_t *);
|
||||
vec_capacity += as_vec(vec)->capacity;
|
||||
}
|
||||
return sym_table_cost(&sys->symtable) +
|
||||
(sys->memory.num_conses * sizeof(cons_t)) + vec_capacity;
|
||||
}
|
||||
|
||||
void sys_free(sys_t *sys)
|
||||
{
|
||||
sym_table_free(&sys->symtable);
|
||||
|
||||
// Iterate through each cell of memory currently allocated and free them
|
||||
for (size_t i = 0; i < VEC_SIZE(&sys->memory.conses, lisp_t **); ++i)
|
||||
{
|
||||
lisp_t *allocated = VEC_GET(&sys->memory.conses, i, lisp_t *);
|
||||
lisp_free(allocated);
|
||||
}
|
||||
|
||||
// Iterate through each cell of memory currently allocated and free them
|
||||
for (size_t i = 0; i < VEC_SIZE(&sys->memory.vectors, lisp_t **); ++i)
|
||||
{
|
||||
lisp_t *allocated = VEC_GET(&sys->memory.vectors, i, lisp_t *);
|
||||
lisp_free(allocated);
|
||||
}
|
||||
|
||||
// Free the containers
|
||||
vec_free(&sys->memory.conses);
|
||||
vec_free(&sys->memory.vectors);
|
||||
|
||||
// Ensure no one treats this as active in any sense
|
||||
memset(sys, 0, sizeof(*sys));
|
||||
}
|
||||
|
||||
lisp_t *make_int(i64 i)
|
||||
{
|
||||
return tag_int(i);
|
||||
}
|
||||
|
||||
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
|
||||
{
|
||||
lisp_t *cons = sys_alloc(sys, TAG_CONS);
|
||||
CAR(cons) = car;
|
||||
CDR(cons) = cdr;
|
||||
return cons;
|
||||
}
|
||||
|
||||
lisp_t *make_vec(sys_t *sys, u64 capacity)
|
||||
{
|
||||
lisp_t *vec = sys_alloc(sys, TAG_VEC);
|
||||
vec_init(as_vec(vec), capacity);
|
||||
return vec;
|
||||
}
|
||||
|
||||
lisp_t *intern(sys_t *sys, sv_t sv)
|
||||
{
|
||||
const char *str = sym_table_find(&sys->symtable, sv);
|
||||
return tag_sym(str);
|
||||
}
|
||||
|
||||
lisp_t *car(lisp_t *lsp)
|
||||
{
|
||||
if (!IS_TAG(lsp, CONS))
|
||||
return NIL;
|
||||
else
|
||||
return CAR(lsp);
|
||||
}
|
||||
|
||||
lisp_t *cdr(lisp_t *lsp)
|
||||
{
|
||||
if (!IS_TAG(lsp, CONS))
|
||||
return NIL;
|
||||
else
|
||||
return CDR(lsp);
|
||||
}
|
||||
|
||||
void lisp_free(lisp_t *item)
|
||||
{
|
||||
switch (get_tag(item))
|
||||
{
|
||||
case TAG_CONS:
|
||||
// Delete the cons
|
||||
free(as_cons(item));
|
||||
break;
|
||||
case TAG_VEC:
|
||||
{
|
||||
vec_t *vec = as_vec(item);
|
||||
vec_free(vec);
|
||||
free(vec);
|
||||
break;
|
||||
}
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SYM:
|
||||
case NUM_TAGS:
|
||||
// shouldn't be dealt with (either constant or dealt with elsewhere)
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
void lisp_free_rec(lisp_t *item)
|
||||
{
|
||||
switch (get_tag(item))
|
||||
{
|
||||
case TAG_CONS:
|
||||
{
|
||||
lisp_free_rec(car(item));
|
||||
lisp_free_rec(cdr(item));
|
||||
free(as_cons(item));
|
||||
break;
|
||||
}
|
||||
case TAG_VEC:
|
||||
{
|
||||
vec_t *vec = as_vec(item);
|
||||
for (size_t i = 0; i < VEC_SIZE(vec, lisp_t **); ++i)
|
||||
{
|
||||
lisp_t *allocated = VEC_GET(vec, i, lisp_t *);
|
||||
lisp_free_rec(allocated);
|
||||
}
|
||||
vec_free(vec);
|
||||
free(vec);
|
||||
break;
|
||||
}
|
||||
case TAG_NIL:
|
||||
case TAG_INT:
|
||||
case TAG_SYM:
|
||||
case NUM_TAGS:
|
||||
// shouldn't be dealt with (either constant or dealt with elsewhere)
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/* 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/>.
|
||||
|
||||
*/
|
||||
82
src/tag.c
82
src/tag.c
@@ -1,82 +0,0 @@
|
||||
/* tag.c: Pointer tagging
|
||||
* Created: 2025-08-19
|
||||
* Author: Aryadev Chavali
|
||||
* License: See end of file
|
||||
* Commentary:
|
||||
*/
|
||||
|
||||
#include <assert.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include <alisp/lisp.h>
|
||||
|
||||
lisp_t *tag_int(i64 i)
|
||||
{
|
||||
return TAG((u64)i, INT);
|
||||
}
|
||||
|
||||
lisp_t *tag_sym(const char *str)
|
||||
{
|
||||
return TAG((u64)str, SYM);
|
||||
}
|
||||
|
||||
lisp_t *tag_vec(const vec_t *vec)
|
||||
{
|
||||
return TAG((u64)vec, VEC);
|
||||
}
|
||||
|
||||
lisp_t *tag_cons(const cons_t *cons)
|
||||
{
|
||||
return TAG((u64)cons, CONS);
|
||||
}
|
||||
|
||||
tag_t get_tag(const lisp_t *lisp)
|
||||
{
|
||||
static_assert(NUM_TAGS == 5);
|
||||
if (!lisp)
|
||||
return TAG_NIL;
|
||||
else if (IS_TAG(lisp, INT))
|
||||
return TAG_INT;
|
||||
|
||||
return (u64)lisp & 0xFF;
|
||||
}
|
||||
|
||||
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)
|
||||
;
|
||||
}
|
||||
|
||||
char *as_sym(lisp_t *obj)
|
||||
{
|
||||
assert(IS_TAG(obj, SYM));
|
||||
return (char *)UNTAG(obj, SYM);
|
||||
}
|
||||
|
||||
cons_t *as_cons(lisp_t *obj)
|
||||
{
|
||||
assert(IS_TAG(obj, CONS));
|
||||
return (cons_t *)UNTAG(obj, CONS);
|
||||
}
|
||||
|
||||
vec_t *as_vec(lisp_t *obj)
|
||||
{
|
||||
assert(IS_TAG(obj, VEC));
|
||||
return (vec_t *)UNTAG(obj, VEC);
|
||||
}
|
||||
|
||||
/* Copyright (C) 2025, 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/>.
|
||||
|
||||
*/
|
||||
Reference in New Issue
Block a user