Compare commits

...

89 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
Aryadev Chavali
7f2dcc3ad2 alisp.org: mark TODOs 2026-03-05 17:32:52 +00:00
Aryadev Chavali
4bc615ab29 lisp_print: print verbose logs for lisp types on VERBOSE_LOGS=2 2026-03-05 17:32:52 +00:00
Aryadev Chavali
fc602f1664 allocator: free_list -> free_vec 2026-03-05 17:32:52 +00:00
Aryadev Chavali
30a87d4a1b some small updates 2026-03-05 17:32:52 +00:00
Aryadev Chavali
9940651ac0 alloc: arena_t -> alloc_t
arena_t doesn't really make sense given we also have a free list.
Better to name it generic.
2026-03-05 17:32:52 +00:00
Aryadev Chavali
be0a6dd0c8 allocator: arena_make now takes nodes off the free list first. 2026-03-05 17:32:52 +00:00
Aryadev Chavali
9a91511e48 sys: plug in allocator 2026-03-05 17:32:52 +00:00
Aryadev Chavali
f9a044f631 allocator: implement a basic allocator 2026-03-05 17:32:52 +00:00
Aryadev Chavali
0e75b541df vec: vec_try_append
Essentially a method to attempt to append data but without doing any
reallocation - stay within the bounds of the capacity.
2026-03-05 17:32:52 +00:00
Aryadev Chavali
e6e501c5a3 lisp: tag_generic, tag_sizeof, and lisp_sizeof 2026-03-05 17:32:52 +00:00
Aryadev Chavali
a79f60a203 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.
2026-03-05 17:32:52 +00:00
Aryadev Chavali
79f53c7916 alisp.org: rework TODOs, setup one for allocators. 2026-02-12 23:03:05 +00:00
Aryadev Chavali
042cc48e8c lisp: split memory into its own structure 2026-02-12 22:51:29 +00:00
Aryadev Chavali
b51aaa3d65 lisp: replace sys_register with sys_alloc
Allows us to abstract allocation away, creating Lisps automatically.
2026-02-12 22:51:29 +00:00
Aryadev Chavali
6499a9dd6d lisp: combine tag.h into lisp.h 2026-02-12 22:51:29 +00:00
Aryadev Chavali
c1cdb8607d lisp: split memory into conses and vectors
During garbage collection, we'll iterate through these two vectors.
Instead of freeing the memory, we can swap cells in the vector and
decrement its size.

The idea is we can attach an allocator to the system where we reuse
memory instead of just allocating everytime.
2026-02-12 22:51:29 +00:00
Aryadev Chavali
7df292ed9e alisp.org: mark WIP -> TODO 2026-02-11 10:31:23 +00:00
Aryadev Chavali
4aad62fec9 alisp.org: update 2026-02-11 10:29:57 +00:00
Aryadev Chavali
a4fb48a863 reader: implement read_vec and setup errors for random closed brackets 2026-02-11 10:29:57 +00:00
Aryadev Chavali
5f05a6a108 lisp: implement TAG_VEC lisp_print method 2026-02-11 10:29:57 +00:00
Aryadev Chavali
e60a7459e0 reader: fix issue with read_list of infinite loop 2026-02-11 10:29:57 +00:00
Aryadev Chavali
4936460b39 reader: factor out read_negative 2026-02-11 10:29:57 +00:00
Aryadev Chavali
04be0ecad0 alisp.org: update todos 2026-02-11 10:29:57 +00:00
Aryadev Chavali
f09e0d33a4 reader: deal with negative prefix numbers in read 2026-02-11 10:29:57 +00:00
Aryadev Chavali
d1d0783fc3 reader: implement read_int 2026-02-11 10:29:57 +00:00
Aryadev Chavali
21254e77bf tag: INT_MAX/INT_MIN are now i64 by default 2026-02-11 10:29:57 +00:00
Aryadev Chavali
e772b06ae5 main: rearrange code and setup prototypes 2026-02-11 10:29:57 +00:00
Aryadev Chavali
eca46069f8 main: print out expressions from reading 2026-02-11 10:29:57 +00:00
Aryadev Chavali
c2f1835b4c main: factor out the stream init code into its own function 2026-02-11 10:29:57 +00:00
Aryadev Chavali
93a52db7cc alisp.org: add TODO about reader macros 2026-02-11 10:29:57 +00:00
Aryadev Chavali
d88bc2baeb alisp.org: mark some TODOs 2026-02-11 10:29:57 +00:00
Aryadev Chavali
2dc0c6080e reader: deal with quotes
This is currently implemented as a parse-time primitive.  Scheme
doesn't seem to have reader macros (which is INSANE) but Common Lisp
does.  We'll need to add a TODO about this.
2026-02-11 10:29:57 +00:00
Aryadev Chavali
8e81e6f762 reader: at every iteration of read_all, skip comments and whitespace 2026-02-11 10:29:57 +00:00
Aryadev Chavali
a49492b27f stream: clean up 2026-02-11 10:29:57 +00:00
Aryadev Chavali
8b2fe97fc2 lisp: sys_cost for memory footprint 2026-02-11 10:29:57 +00:00
Aryadev Chavali
ff512986f8 symtable: sym_table_cost
Useful for figuring out the rough memory footprint (actually utilised)
by the symbol table.
2026-02-11 10:29:57 +00:00
Aryadev Chavali
47f33cb969 tag: make function inputs constant 2026-02-11 10:29:57 +00:00
Aryadev Chavali
39e5b76f8b lisp: lisp_print 2026-02-11 10:29:57 +00:00
Aryadev Chavali
b91e79933b symtable: refactor for SV changes and propagate 2026-02-11 10:29:57 +00:00
Aryadev Chavali
3e7734037c sv: rearrange sv_substr and sv_truncate 2026-02-11 10:29:57 +00:00
Aryadev Chavali
9f3bb57972 sv: major refactor
- Internal data pointer is read only by default => any uses that
  require use of the pointer itself (freeing, mutating) must perform a
  cast.

- refactor tests to use some new sv macros and functions, and clean
  them up.

- slight cleanup of sv.c
2026-02-11 10:29:57 +00:00
Aryadev Chavali
b646ae3f7e sv: fix sv_substr
Issue I came up with when looking at the code, based on
sv_chop_right's impl.  Why do we keep this function around again?
2026-02-11 10:29:57 +00:00
Aryadev Chavali
818d4da850 sv: SV_AUTO macro (for literal strings/literal byte arrays really). 2026-02-11 10:29:57 +00:00
Aryadev Chavali
daa1d3d565 lisp: add and implement lisp_free_rec
May be useful for testing.
2026-02-11 10:29:57 +00:00
Aryadev Chavali
b7fc5170b0 reader: implement read_sym and read_list
To be tested properly.
2026-02-11 10:29:57 +00:00
Aryadev Chavali
d02174ea8b Makefile: add reader to units to compile 2026-02-11 10:29:57 +00:00
Aryadev Chavali
7ef6905d7a main: fit reader into main. 2026-02-11 10:29:57 +00:00
Aryadev Chavali
c12f4b2d2c reader: some work done on basic API 2026-02-11 10:29:57 +00:00
Aryadev Chavali
b8d0ee2c7f .dir-locals: added compile-command for testing
When I'm writing unit test code, it's nicer to compile with full logs
by default.
2026-02-09 09:57:46 +00:00
Aryadev Chavali
fe727d75e4 remove breaks after return in switch-case 2026-02-09 09:57:04 +00:00
Aryadev Chavali
06a4eafbb9 stream: optimise stream_substr_abs, stream_till, stream_while
In the base cases of STRINGS and FILES, these functions should be very
quick (operating on stuff in memory), and amortized for pipes.
2026-02-09 09:57:04 +00:00
Aryadev Chavali
fc5a6eb8fb stream: refactor stream_seek_forward for changes in FILE API 2026-02-09 09:57:04 +00:00
Aryadev Chavali
5c7fb0fabd stream: stream_stop -> stream_free 2026-02-09 09:57:04 +00:00
Aryadev Chavali
f164427b47 stream: stream_reset
We can reuse the same stream by resetting it.  We don't delete the
cached data.
2026-02-09 09:57:04 +00:00
Aryadev Chavali
2238f348e1 stream: stream_line_col includes current position in computation 2026-02-09 09:57:04 +00:00
Aryadev Chavali
f56a59ff7a stream: STREAM_TYPE_FILE will now read file upfront
No more having to chunk read - if ~stream_init_file~ is used, the
constructor slurps the entire file into the cache.  This pays up front
for a bunch of checks essentially.

~stream_init_pipe~ should be used for chunked reading.
2026-02-09 09:57:04 +00:00
Aryadev Chavali
6a54c54bfb stream: a bit of tidying up 2026-02-09 09:57:04 +00:00
Aryadev Chavali
2855536bdd stream: a few further refactors due to new sv functions 2026-02-09 09:57:04 +00:00
Aryadev Chavali
8426f04734 sv: refactor to use sv_truncate 2026-02-09 09:57:04 +00:00
Aryadev Chavali
459f434e5d stream: bug fix on stream_while/stream_till (due to eda2711)
The new versions of stream_substr require exact sizes.
2026-02-09 09:57:04 +00:00
Aryadev Chavali
9ee8955908 stream: Refactor stream_substr and stream_substr_abs using stream_sv
Bit more elegant, and allows the caller code to focus on the task
rather than string management.
2026-02-09 09:57:04 +00:00
Aryadev Chavali
477abc9aa1 stream: stream_sv and stream_sv_abs
Just straight string views into the current stream content - obviously
may not be stable.  Helpful when analysing a non-moving stream.
2026-02-09 09:57:04 +00:00
oreodave
a6d3d861b7 sv: add a few more functions
* alisp.org: reset state of Unit tests to TODO

* alisp.org: take sv_t tasks out of the backlog and set to WIP

* sv: add prototypes for sv_chop_{left,right} and sv_substr

* sv: implement sv_chop_{left, right} and sv_substr

* sv: sv_till and sv_while

* sv: add sv_truncate

When you just want to decrease to a specific size, sv_chop_right is a
bit cumbersome.

* alisp.org: Update and adjust
2026-02-06 07:02:10 +00:00
oreodave
a65964e2f7 tests: refactor testing and implement a bunch of tests
* tests: split of symtable testing into its own suite

makes sense to be there, not in the lisp API

* tests: Added string view suite

sv_copy is the only function, but we may have others later.

* tests: Meaningful and pretty logging for tests

* tests: slight cleanliness

* tests: c23 allows you to inline stack allocated arrays in struct decls

* test: Added definition to make default testing less verbose

TEST_VERBOSE is a preprocesser directive which TEST is dependent on.
By default it is 0, in which case TEST simply fails if the condition
is not true.  Otherwise, a full log (as done previously) is made.

* Makefile: added mode flag for full logs

MODE=full will initialise a debug build with all logs, including test
logs.  Otherwise, MODE=debug just sets up standard debug build with
main logs but no testing logs.  MODE=release optimises and strips all
logs.

* tests: fix size of LISP_API_SUITE tests

* test_lisp_api: int_test -> smi_test, added smi_oob_test

* test_lisp_api: sym_test -> sym_fresh_test

* test_lisp_api: added sym_unique_test

* alisp.org: Added some tasks

* symtable: sym_table_cleanup -> sym_table_free

* lisp: split off lisp_free as it's own function

lisp_free will do a shallow clean of any object, freeing its
associated memory.  It won't recur through any containers, nor will it
freakout if you give it something that is constant (symbols, small
integers, NIL, etc).

* test_lisp_api: added sys_test

* test_stream: basic skeleton

* test_stream: implement stream_test_string

* test_stream: Enable only stream_test_string

* tests: enable STREAM_SUITE

* sv: fix possible runtime issue with NULL SV's in sv_copy

* alisp.org: add TODOs for all the tests required for streams

* tests: Better suite creation

While the previous method of in-lining a stack allocated array of
tests into the suite struct declaration was nice, we had to update
size manually.

This macro will allow us to just append new tests to the suite without
having to care for that.  It generates a uniquely named variable for
the test array, then uses that test array in the suite declaration.
Nice and easy.

* test: TEST_INIT macro as a prologue for any unit test

* main: Put all variable declarations at start of main to ensure decl

There is a chance that /end/ is jumped to without the FILE pointer or
stream actually being declared.  This deals with that.

* stream: Make stream name a constant cstr

We don't deal with the memory for it anyway.

* stream: do not initialise file streams with a non-empty vector

Because of the not_inlined trick, a 0 initialised SBO vector is
completely valid to use if required.  Future /vec_ensure/'s will deal
with it appropriately.  So there's no need to initialise the vector
ahead of time like this.

* test_stream: implement stream_test_file

We might need to setup a prelude for initialising a file in the
filesystem for testing here - not only does stream_test_file need it,
but I see later tests requiring an equivalence check for files and
strings (variants of a stream).

* test_stream: setup prologue and epilogue as fake tests in the suite

Standard old test functions, but they don't call TEST_INIT or
TEST_PASSED.  They're placed at the start and at the end of the test
array.

Those macros just do printing anyway, so they're not necessary.

* tests: TEST_INIT -> TEST_START, TEST_PASSED -> TEST_END

* tests: TEST_START only logs if TEST_VERBOSE is enabled.

* test_lisp_api: "cons'" -> "conses"

* alisp.org: Mark off completed stream_test_file

* test_stream: implement stream_test_peek_next

* test_stream: randomise filename

Just to make sure it's not hardcoded or anything.

* test_stream: make filename bigger, and increase the random alphabet

* test: seed random number generator

* test_stream: don't write null terminator to mock file

* stream: stream_seek will do clamped movement if offset is invalid

If a forward/backward offset is too big, we'll clamp to the edges of
the file rather than failing completely.  We return the number of
bytes moved so callers can still validate, but the stream API can now
deal with these situations a bit more effectively.

* test_stream: implement stream_test_seek

* stream: ensure stream_stop resets the FILE pointer if STREAM_TYPE_FILE

* stream: stream_substr's call to stream_seek_forward refactored

Following stream_seek_forward's own refactor, where we get offsets
back instead of just a boolean, we should verify that offset.

* main: put stream_stop before FILE pointer close

As stream_stop requires a valid FILE pointer (fseek), we need to do it
before we close the pipe.

* test_vec: vec_test_substr -> vec_test_gen_substr

* test_stream: implement stream_test_substr

* alisp: add TODO for sv_t
2026-02-06 06:08:13 +00:00
Aryadev Chavali
40ef094b68 alisp.org: Remove notes and overview
Not needed with what we're doing currently.  I'll make proper
documentation when I'm done.
2026-02-05 04:35:54 +00:00
Aryadev Chavali
656226c050 alisp.org: make a backlog for tasks 2026-02-05 04:35:47 +00:00
Aryadev Chavali
edb2f5c5c8 dir-locals: run testing, then examples for default compile-command
By default we should test all our code for regressions.  I'm always
running the examples anyway to test new features, so we should have
that recipe run afterwards.

If a test fails, that's first priority to fix.

If an example fails, time to continue working.
2026-02-05 04:34:29 +00:00
Aryadev Chavali
118a25055c main: the beginnings of alisp.out
We've started composing the stuff we've made so far I/O wise,
initialising a stream based off user command line input.  We even
allow stdin!
2026-02-05 04:32:48 +00:00
Aryadev Chavali
e7d3bca4d7 stream: fix bug with stream_next; return the next character
It seems we'd return the previously peeked character when
stream_next'ing, when really we should be sending the updated
character.
2026-02-05 04:29:07 +00:00
33 changed files with 2464 additions and 593 deletions

View File

@@ -1,6 +1,8 @@
;;; Directory Local Variables -*- no-byte-compile: t -*- ;;; Directory Local Variables -*- no-byte-compile: t -*-
;;; For more information see (info "(emacs) Directory Variables") ;;; For more information see (info "(emacs) Directory Variables")
((nil . ((compile-command . "make MODE=debug") ((nil . ((compile-command . "make MODE=debug test examples")
(+license/license-choice . "GNU General Public License Version 2"))) (+license/license-choice . "GNU General Public License Version 2")))
(c-mode . ((mode . clang-format)))) (c-mode . ((mode . clang-format)))
("test" .
((nil . ((compile-command . "make MODE=full test"))))))

View File

@@ -5,19 +5,22 @@ 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 -DVERBOSE_LOGS=1 DFLAGS=-ggdb -fsanitize=address -fsanitize=undefined
RFLAGS=-O3 RFLAGS=-O3
MODE=release MODE=release
ifeq ($(MODE), release) ifeq ($(MODE), release)
CFLAGS=$(GFLAGS) $(RFLAGS) CFLAGS=$(GFLAGS) $(RFLAGS)
else else ifeq ($(MODE), debug)
CFLAGS=$(GFLAGS) $(DFLAGS) CFLAGS=$(GFLAGS) $(DFLAGS) -DVERBOSE_LOGS=1
else ifeq ($(MODE), full)
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/tag.c src/lisp.c UNITS=src/sv.c src/vec.c src/string.c src/stream.c src/symtable.c src/lisp.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

229
alisp.org
View File

@@ -3,49 +3,17 @@
#+date: 2025-08-20 #+date: 2025-08-20
#+filetags: :alisp: #+filetags: :alisp:
* Notes
** Overview
~alisp.h~ is a single header for the entire runtime. We'll also have a
compiled shared library ~alisp.so~ which one may link against to get
implementation. That's all that's necessary for one to write C code
that targets our Lisp machine.
We'll have a separate header + library for the compiler since that's
not strictly necessary for transpiled C code to consume. This will
transpile Lisp code into C, which uses the aforementioned ~alisp~
header and library to compile into a native executable.
** WIP How does transpiled code operate?
My current idea is: we're transpiling into C for the actual Lisp code.
User made functions can be transpiled into C functions, which we can
mangle names for. Macros... I don't know, maybe we could have two
function pointer tables so we know how to execute them?
Then, we'll have an associated "descriptor" file which describes the
functions we've transpiled. Bare minimum, this file has to have a
"symbol name" to C mangled function name dictionary. We can also add
other metadata as we need.
*** TODO Deliberate on whether we compile into a shared library or not
If we compile these C code objects into shared libraries, the
descriptor needs to concern itself with code locations. This might be
easier in a sense, since the code will already be compiled.
** WIP How do we call native code?
When we're calling a natively compiled function, we can use this
metadata mapping to call the C function. This native code will use
our Lisp runtime, same as any other code, so it should be pretty
seamless in that regard. But we'll need to set a calling convention
in order to make calling into this seamless from a runtime
perspective.
* Tasks * Tasks
** TODO Capitalise symbols (TBD) :optimisation:design: ** String views :strings:
Should we capitalise symbols? This way, we limit the symbol table's [[file:include/alisp/sv.h::/// String Views]]
possible options a bit (potentially we could design a better hashing *** DONE sv_substr
algorithm?) and it would be kinda like an actual Lisp. Takes an index and a size, returns a string view to that substring.
** TODO Design Strings *** DONE sv_chop_left and sv_chop_right
Super obvious.
*** TODO Design Strings for the Lisp :api:
We have ~sv_t~ so our basic C API is done. We just need pluggable We have ~sv_t~ so our basic C API is done. We just need pluggable
functions to construct and deconstruct strings as lisps. functions to construct and deconstruct strings as lisps.
** WIP Reader system ** Reader system :reader:
We need to design a reader system. The big idea: given a "stream" of We need to design a reader system. The big idea: given a "stream" of
data, we can break out expressions from it. An expression could be data, we can break out expressions from it. An expression could be
either an atomic value or a container. either an atomic value or a container.
@@ -83,46 +51,103 @@ easier. We're not going to do anything more advanced than the API
i.e. no parsing. i.e. no parsing.
**** DONE Design the tagged union **** DONE Design the tagged union
**** DONE Design the API **** DONE Design the API
*** WIP Figure out the possible parse errors
*** DONE Design what a "parser function" would look like *** DONE Design what a "parser function" would look like
The general function is something like ~stream -> T | Err~. What The general function is something like ~stream -> T | Err~. What
other state do we need to encode? other state do we need to encode?
*** WIP Write a parser for integers *** DONE Write a parser for integers
*** TODO Write a parser for symbols *** DONE Write a parser for symbols
*** TODO Write a parser for lists *** DONE Write a parser for lists
*** TODO Write a parser for vectors *** DONE Write a parser for vectors
*** TODO Write a generic parser that returns a generic expression *** TODO Write a parser for strings
** TODO Test system registration of allocated units :test: Requires [[*Design Strings for the Lisp]] to be complete first.
In particular, does clean up work as we expect? Do we have situations *** TODO Write the general parser
where we may double free or not clean up something we should've? ** Design :design:
** TODO Design garbage collection scheme :design:gc: *** TODO Design Big Integers :api:
We currently have 62 bit integers implemented via immediate values
embedded in a pointer. We need to be able to support even _bigger_
integers. How do we do this?
*** TODO Capitalise symbols (TBD) :optimisation:
Should we capitalise symbols? This way, we limit the symbol table's
possible options a bit (potentially we could design a better hashing
algorithm?) and it would be kinda like an actual Lisp.
*** TODO Consider reader macros :reader:
Common Lisp has so-called "reader macros" which allows users to write
Lisp code that affects further Lisp code reading. It's quite
powerful.
Scheme doesn't have it. Should we implement this?
** Allocator :allocator:
*** Some definitions
- Managed objects are allocations that are generated as part of
evaluating user code i.e. strings, vectors, conses that are all made
as part of evaluating code.
- Unmanaged objects are allocations we do as part of the runtime.
These are things that we expect to have near infinite lifetimes
(such as the symbol table, vector of allocated objects, etc).
*** DONE Design an allocator
We'll need an allocator for all our managed objects. Requirements:
- Stable pointers (memory that has already been allocated should be
free to utilise via the same pointer for the lifetime of the
allocator)
- Able to tag allocations as unused (i.e. "free") and able to reuse
these allocations
- This will link into the garbage collector, which should yield a
sequence of objects that were previously tagged as unfree and
should be "freed".
- Able to allocate all the managed types we have
**** DONE Design allocation data structures
**** DONE Design allocation methods for different lisp types
- Strings (when implemented)
***** DONE Conses
***** DONE Vectors
**** DONE Design allocation freeing method
*** TODO Design garbage collection scheme :gc:
Really, regardless of what I do, we need to have some kind of garbage Really, regardless of what I do, we need to have some kind of garbage
collection header on whatever we allocate e.g. references if we collection header on whatever managed objects we allocate. We need to
reference count for GC. perform garbage collection against the managed objects, and leave the
*** TODO Mark stage unmanaged objects to the runtime.
When some item is being used by another, we need a way to adjust the **** TODO Mark stage
metadata such that the system is aware of it being used. We need to mark all objects that are currently accessible from the
environment. This means we need to have a root environment which we
mark all our accessible objects from. Any objects that aren't marked
by this obviously are inaccessible, so we can then sweep them.
For example, say I have X, Y as random allocated objects. Then I How do we store this mark on our managed objects? I think the
construct CONS(X, Y). Then, ref(X) and ref(Y) need to be incremented simplest approach would be to allocate an extra 8 bytes just before
to say I'm using them. any managed object we allocate i.e. [8 byte buffer] <object>. Then,
*** TODO Sweep during the mark phase, we can walk back those 8 bytes and
Say I have an object that I construct, C. If ref(C) = 0, then C is no inspect/mutate the mark.
longer needed, and is free. **** TODO Sweep
Once we've marked all objects that are accessible, we need to
investigate all the objects that aren't. We do have
[[file:alisp.h::vec_t memory;][this]] which provides a global map of
all the stuff we've allocated so far ([[file:alisp.h::void
sys_register(sys_t *, lisp_t *);][sys_register]] is used to add to
this, and any managed object is expected to register).
There are two components to this: We can iterate through the map and collect all the unmarked objects.
- we need a way of decrementing references if an object is no longer needed. What do we do with these?
- we need a way of running through everything we've allocated so far
to figure out what's free to take away.
Once we've filtered out what we don't need anymore, what should we do 1) They are technically freestanding objects allocated through
with them? Naive approach would be to just actually ~free~ the cells ~calloc~, so we could just free them.
in question. But I think the next item may be a better idea. 2) Manage some collection of previous allocations to reuse in our next
*** TODO Use previous allocations if they're free to use allocation.
If we have no references to a cell, this cell is free to use. In
other words, if I later allocate something of the same type, instead
of allocating a new object, why not just use the one I've already got?
Option (1) is obvious and relatively clean to setup in our current
idea:
- Say at index I we have an object that is unmarked
- Free the associated object at index I
- Swap the end of the array with the cell at index I, then decrement
the size of the container
This is an O(1) time operation.
Option (2) is also relatively straightforward, but we need another
counter in order to make it work:
- Say at index I we have an object that is unmarked
- Swap the end of the array with the cell at index I, then decrement
the size of the container
**** TODO Use previous allocations if they're free to use
This way, instead of deleting the memory or forgetting about it, we This way, instead of deleting the memory or forgetting about it, we
can reuse it. We need to be really careful to make sure our ref(X) is can reuse it. We need to be really careful to make sure our ref(X) is
actually precise, we don't want to trample on the user's hard work. actually precise, we don't want to trample on the user's hard work.
@@ -151,14 +176,62 @@ Latter approach time complexity:
Former approach is better time complexity wise, but latter is way Former approach is better time complexity wise, but latter is way
better in terms of simplicity of code. Must deliberate. better in terms of simplicity of code. Must deliberate.
** TODO Design Big Integers ** Unit tests :tests:
We currently have 62 bit integers implemented via immediate values *** TODO Test streams :streams:
embedded in a pointer. We need to be able to support even _bigger_ **** DONE Test file init
integers. How do we do this? [[file:test/test_stream.c::void stream_test_file(void)]]
** DONE Test value constructors and destructors :test: ***** DONE Test successful init from real files
Ensure stream_size is 0 i.e. we don't read anything on creation.
Also ensure stream_eoc is false.
***** DONE Test failed init from fake files
**** DONE Test peeking and next
[[file:test/test_stream.c::void stream_test_peek_next(void)]]
- Peeking with bad streams ('\0' return)
- Peeking with good streams (no effect on position)
- Next with bad streams ('\0' return, no effect on position)
- Next with good streams (effects position)
- Peeking after next (should just work)
**** DONE Test seeking
[[file:test/test_stream.c::void stream_test_seek(void)]]
- Seeking forward/backward on a bad stream (should stop at 0)
- Seeking forward/backward too far (should clamp)
- Seeking forward/backward zero sum via relative index (stream_seek)
**** DONE Test substring
[[file:test/test_stream.c::void stream_test_substr(void)]]
- Substr on bad stream (NULL sv)
- Substr on bad position/size (NULL sv)
- Substr relative/absolute (good SV)
**** TODO Test till
[[file:test/test_stream.c::void stream_test_till(void)]]
- till on a bad stream (NULL SV)
- till on an ended stream (NULL SV)
- till on a stream with no items in search string (eoc)
- till on a stream with all items in search string (no effect)
- till on a stream with prefix being all search string (no effect)
- till on a stream with suffix being all search string (stops at
suffix)
**** TODO Test while
[[file:test/test_stream.c::void stream_test_while(void)]]
- while on a bad stream (NULL SV)
- while on an ended stream (NULL SV)
- while on a stream with no items in search string (no effect)
- while on a stream with all items in search string (eoc)
- while on a stream with prefix being all search string (effect)
- while on a stream with suffix being all search string (no effect)
**** TODO Test line_col
[[file:test/test_stream.c::void stream_test_line_col(void)]]
- line_col on bad stream (no effect on args)
- line_col on eoc stream (should go right to the end)
- line_col on random points in a stream
*** TODO Test reader :reader:
*** DONE Test system registration of allocated units
In particular, does clean up work as we expect? Do we have situations
where we may double free or not clean up something we should've?
** Completed
*** DONE Test value constructors and destructors :test:
Test if ~make_int~ works with ~as_int,~ ~intern~ with ~as_sym~. Test if ~make_int~ works with ~as_int,~ ~intern~ with ~as_sym~.
Latter will require a symbol table. Latter will require a symbol table.
** DONE Test containers constructors and destructors :test: *** DONE Test containers constructors and destructors :test:
Test if ~make_vec~ works with ~as_vec~, ~cons~ with ~as_cons~ AND Test if ~make_vec~ works with ~as_vec~, ~cons~ with ~as_cons~ AND
~CAR~, ~CDR~. ~CAR~, ~CDR~.

BIN
doc/r7rs.pdf Normal file

Binary file not shown.

View File

@@ -8,13 +8,13 @@
#ifndef ALISP_H #ifndef ALISP_H
#define ALISP_H #define ALISP_H
#include <alisp/allocator.h>
#include <alisp/base.h> #include <alisp/base.h>
#include <alisp/lisp.h> #include <alisp/lisp.h>
#include <alisp/reader.h> #include <alisp/reader.h>
#include <alisp/stream.h> #include <alisp/stream.h>
#include <alisp/sv.h> #include <alisp/sv.h>
#include <alisp/symtable.h> #include <alisp/symtable.h>
#include <alisp/tag.h>
#include <alisp/vec.h> #include <alisp/vec.h>
#endif #endif

61
include/alisp/allocator.h Normal file
View File

@@ -0,0 +1,61 @@
/* allocator.h: Lisp Allocator
* Created: 2026-02-12
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#ifndef ALLOCATOR_H
#define ALLOCATOR_H
#include <alisp/lisp.h>
#include <alisp/vec.h>
#define ALLOC_PAGE_DEFAULT_SIZE 512
typedef struct
{
u64 padding : 56;
tag_t tag : 8;
u64 references;
} alloc_metadata_t;
static_assert(sizeof(alloc_metadata_t) == 16,
"16 byte metadata required for alignment purposes");
typedef struct
{
alloc_metadata_t metadata;
u8 data[];
} alloc_node_t;
typedef struct
{
vec_t data;
} page_t;
typedef struct
{
vec_t pages;
vec_t free_vec;
} alloc_t;
lisp_t *alloc_make(alloc_t *, tag_t type);
void alloc_delete(alloc_t *, lisp_t *);
u64 alloc_cost(alloc_t *);
void alloc_free(alloc_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

@@ -8,7 +8,9 @@
#ifndef LISP_H #ifndef LISP_H
#define LISP_H #define LISP_H
#include <alisp/symtable.h> #include <stdio.h>
#include <alisp/string.h>
#include <alisp/vec.h> #include <alisp/vec.h>
#define NIL 0 #define NIL 0
@@ -21,34 +23,53 @@ typedef struct
lisp_t *car, *cdr; lisp_t *car, *cdr;
} cons_t; } cons_t;
/// System context /// Tagging system
typedef struct typedef enum Tag
{ {
vec_t memory; TAG_SMI = 0b00000001, // Atomic types
sym_table_t symtable; TAG_SYM = 0b00000011,
} sys_t; TAG_NIL = 0b00000000, // Container types (0 LSB)
TAG_CONS = 0b00000010,
TAG_VEC = 0b00000100,
TAG_STR = 0b00000110,
NUM_TAGS = 6,
} tag_t;
void sys_init(sys_t *); // Some helper macros for tagging
void sys_register(sys_t *, lisp_t *); #define SHIFT_TAG (8)
void sys_free(sys_t *); #define MASK_TAG ((1 << SHIFT_TAG) - 1)
/// Constructors and destructors #define TAG(PTR, TYPE) ((lisp_t *)((((u64)(PTR)) << SHIFT_TAG) | TAG_##TYPE))
lisp_t *make_int(i64); #define UNTAG(PTR) (((u64)PTR) >> SHIFT_TAG)
lisp_t *make_vec(sys_t *, u64); #define GET_TAG(PTR) ((tag_t)(((u64)(PTR)) & MASK_TAG))
lisp_t *intern(sys_t *, sv_t); #define IS_TAG(PTR, TYPE) (GET_TAG(PTR) == TAG_##TYPE)
lisp_t *cons(sys_t *, lisp_t *, lisp_t *);
i64 as_int(lisp_t *); #define INT_BITS ((sizeof(i64) * 8) - SHIFT_TAG)
#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_cons(const cons_t *);
lisp_t *tag_vec(const vec_t *);
lisp_t *tag_str(const str_t *);
lisp_t *tag_generic(void *, tag_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)
lisp_t *car(lisp_t *);
lisp_t *cdr(lisp_t *);
#endif #endif
/* Copyright (C) 2026 Aryadev Chavali /* Copyright (C) 2026 Aryadev Chavali

View File

@@ -8,13 +8,18 @@
#ifndef READER_H #ifndef READER_H
#define READER_H #define READER_H
#include <alisp/lisp.h>
#include <alisp/stream.h> #include <alisp/stream.h>
#include <alisp/sys.h>
typedef enum typedef enum
{ {
READ_ERR_OK = 0, READ_ERR_OK = 0,
READ_ERR_EOF, READ_ERR_EOF,
READ_ERR_EXPECTED_CLOSED_BRACE,
READ_ERR_EXPECTED_CLOSED_SQUARE_BRACKET,
READ_ERR_EXPECTED_CLOSING_SPEECHMARKS,
READ_ERR_UNEXPECTED_CLOSED_BRACE,
READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET,
READ_ERR_UNKNOWN_CHAR, READ_ERR_UNKNOWN_CHAR,
} read_err_t; } read_err_t;

View File

@@ -40,7 +40,7 @@ typedef struct
typedef struct typedef struct
{ {
stream_type_t type; stream_type_t type;
char *name; const char *name;
u64 position; u64 position;
union union
{ {
@@ -51,10 +51,13 @@ typedef struct
#define STREAM_DEFAULT_CHUNK 64 #define STREAM_DEFAULT_CHUNK 64
stream_err_t stream_init_string(stream_t *, char *, sv_t); stream_err_t stream_init_string(stream_t *, const char *, sv_t);
stream_err_t stream_init_pipe(stream_t *, char *, FILE *); stream_err_t stream_init_pipe(stream_t *, const char *, FILE *);
stream_err_t stream_init_file(stream_t *, char *, FILE *); // NOTE: stream_init_file will attempt to read all content from the FILE
void stream_stop(stream_t *); // descriptor. Use with caution.
stream_err_t stream_init_file(stream_t *, const char *, FILE *);
void stream_reset(stream_t *);
void stream_free(stream_t *);
// End of Content (i.e. we've consumed all cached content/file) // End of Content (i.e. we've consumed all cached content/file)
bool stream_eoc(stream_t *); bool stream_eoc(stream_t *);
@@ -66,9 +69,15 @@ char stream_next(stream_t *);
// Peek current character, do not push position // Peek current character, do not push position
char stream_peek(stream_t *); char stream_peek(stream_t *);
// Move forward or backward in the stream, return success of operation // Move forward or backward in the stream, return success of operation
bool stream_seek(stream_t *, i64); u64 stream_seek(stream_t *, i64);
bool stream_seek_forward(stream_t *, u64); u64 stream_seek_forward(stream_t *, u64);
bool stream_seek_backward(stream_t *, u64); u64 stream_seek_backward(stream_t *, u64);
// Return a string view to stream data relative to the current position of the
// stream
sv_t stream_sv(stream_t *);
// Return a string view to data from the start of the stream
sv_t stream_sv_abs(stream_t *);
// Return a relative substring of a given size // Return a relative substring of a given size
sv_t stream_substr(stream_t *, u64); sv_t stream_substr(stream_t *, u64);

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

@@ -14,11 +14,12 @@
typedef struct typedef struct
{ {
u64 size; u64 size;
char *data; const char *data;
} sv_t; } sv_t;
// String view macro constructor // String view macro constructor
#define SV(DATA, SIZE) ((sv_t){.data = (DATA), .size = (SIZE)}) #define SV(DATA, SIZE) ((sv_t){.data = (DATA), .size = (SIZE)})
#define SV_AUTO(DATA) ((sv_t){.data = (void *)(DATA), .size = sizeof(DATA) - 1})
// Pretty printers // Pretty printers
#define SV_FMT(SV) (int)(SV).size, (SV).data #define SV_FMT(SV) (int)(SV).size, (SV).data
#define PR_SV "%.*s" #define PR_SV "%.*s"
@@ -26,6 +27,13 @@ typedef struct
// String view functions // String view functions
sv_t sv_copy(sv_t); sv_t sv_copy(sv_t);
sv_t sv_chop_left(sv_t, u64 size);
sv_t sv_chop_right(sv_t, u64 size);
sv_t sv_truncate(sv_t, u64 newsize);
sv_t sv_substr(sv_t, u64 position, u64 size);
sv_t sv_till(sv_t, const char *reject);
sv_t sv_while(sv_t, const char *accept);
#endif #endif

View File

@@ -21,8 +21,11 @@ typedef struct
#define SYM_TABLE_INIT_SIZE (1 << 10) #define SYM_TABLE_INIT_SIZE (1 << 10)
void sym_table_init(sym_table_t *); void sym_table_init(sym_table_t *);
char *sym_table_find(sym_table_t *, sv_t); const char *sym_table_find(sym_table_t *, sv_t);
void sym_table_cleanup(sym_table_t *); void sym_table_free(sym_table_t *);
// Debugging function: total memory used by symbol table.
u64 sym_table_cost(sym_table_t *);
#endif #endif

57
include/alisp/sys.h Normal file
View File

@@ -0,0 +1,57 @@
/* 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/allocator.h>
#include <alisp/lisp.h>
#include <alisp/symtable.h>
/// System context
typedef struct
{
alloc_t memory;
sym_table_t symtable;
} sys_t;
void sys_init(sys_t *);
lisp_t *sys_alloc(sys_t *, tag_t type);
void sys_delete(sys_t *, lisp_t *);
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 *intern(sys_t *, sv_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 *cdr(lisp_t *);
void lisp_free(sys_t *, lisp_t *);
void lisp_free_rec(sys_t *, 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/>.
*/

View File

@@ -1,68 +0,0 @@
/* tag.h: Pointer tagging
* Created: 2026-02-04
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#ifndef TAG_H
#define TAG_H
#include <alisp/lisp.h>
typedef enum Tag
{
TAG_NIL = 0b00000000, // Start of atomic types
TAG_INT = 0b00000001, // Special tag so we can encode 63 bit integers
TAG_SYM = 0b00000100,
TAG_CONS = 0b00000010, // Start of container types
TAG_VEC = 0b00000110,
NUM_TAGS = 5,
} 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
#define TAG(PTR, TYPE) ((lisp_t *)(((PTR) << SHIFT_##TYPE) | TAG_##TYPE))
#define IS_TAG(PTR, TYPE) (((u64)(PTR) & MASK_##TYPE) == TAG_##TYPE)
#define UNTAG(PTR, TYPE) (((u64)PTR) >> SHIFT_##TYPE)
#define INT_MAX ((1L << 62) - 1)
#define INT_MIN (-(1L << 62))
tag_t get_tag(lisp_t *);
lisp_t *tag_int(i64);
lisp_t *tag_sym(char *);
lisp_t *tag_cons(cons_t *);
lisp_t *tag_vec(vec_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

@@ -31,12 +31,18 @@ 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
void vec_append(vec_t *, const void *const, u64); void vec_append(vec_t *, const void *const, u64);
// Try to append without allocating memory
bool vec_try_append(vec_t *, const void *const, u64);
void vec_ensure_free(vec_t *, u64); void vec_ensure_free(vec_t *, u64);
void vec_clone(vec_t *, vec_t *); void vec_clone(vec_t *, vec_t *);

256
src/allocator.c Normal file
View File

@@ -0,0 +1,256 @@
/* allocator.c: Allocator implementations
* Created: 2026-02-12
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include <stdlib.h>
#include <alisp/allocator.h>
#include <alisp/lisp.h>
#include <alisp/vec.h>
#include <string.h>
page_t *make_page(u64 size)
{
page_t *page = calloc(1, sizeof(*page));
vec_init(&page->data, MAX(size, ALLOC_PAGE_DEFAULT_SIZE));
return page;
}
alloc_node_t *make_node(page_t *page, tag_t type)
{
alloc_node_t *node = NULL;
u64 size = sizeof(*node);
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_CONS:
size += sizeof(cons_t);
break;
case TAG_VEC:
size += sizeof(vec_t);
break;
case TAG_STR:
size += sizeof(str_t);
break;
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
default:
FAIL("Unreachable");
return node;
}
// We must ensure size is a multiple of 8 for alignment purposes
size = (size & 0b111) == 0 ? size : size + (8 - (size & 0b111));
if (!vec_try_append(&page->data, NULL, size))
return NULL;
node = (alloc_node_t *)(vec_data(&page->data) + page->data.size - size);
node->metadata = (alloc_metadata_t){.references = 0, .tag = type};
return node;
}
alloc_node_t *lisp_to_node(lisp_t *lisp)
{
void *raw_ptr = NULL;
static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{
case TAG_CONS:
raw_ptr = as_cons(lisp);
break;
case TAG_VEC:
raw_ptr = as_vec(lisp);
break;
case TAG_STR:
raw_ptr = as_str(lisp);
break;
case TAG_NIL: // These shouldn't be allocated
case TAG_SMI:
case TAG_SYM:
default:
FAIL("Unreachable");
return NIL;
}
alloc_node_t *node = raw_ptr;
return &node[-1];
}
lisp_t *alloc_make(alloc_t *alloc, tag_t type)
{
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_CONS:
case TAG_VEC:
case TAG_STR:
break;
case TAG_NIL: // These shouldn't be allocated
case TAG_SMI:
case TAG_SYM:
default:
FAIL("Unreachable");
return NIL;
}
// We want to try to fill this node with an allocation of this type.
alloc_node_t *node = NULL;
// Try to get something from the free vector
u64 free_vec_size = VEC_SIZE(&alloc->free_vec, alloc_node_t *);
for (u64 i = 0; i < free_vec_size; ++i)
{
alloc_node_t **nodeptr = &VEC_GET(&alloc->free_vec, i, alloc_node_t *);
// Skip any nodes that don't have the right type.
if (nodeptr[0]->metadata.tag != type)
continue;
assert("Expected free node to have no references" &&
nodeptr[0]->metadata.references == 0);
// Pop this node off the free vector by swapping it with the last item and
// decrementing the size of the vector.
alloc_node_t **lastptr =
&VEC_GET(&alloc->free_vec, free_vec_size - 1, alloc_node_t *);
alloc_node_t *val = *nodeptr;
*nodeptr = *lastptr;
*lastptr = val;
// Decrement the size of the free vector
alloc->free_vec.size -= sizeof(val);
// Then use that valid (and now unused) node as our return.
node = *lastptr;
goto end;
}
// We couldn't get anything from the free vector, so try to allocate a fresh
// one against one of the pages.
FOR_VEC(i, &alloc->pages, page_t *)
{
page_t *page = VEC_GET(&alloc->pages, i, page_t *);
node = make_node(page, type);
if (node)
goto end;
}
// There aren't any pages we can allocate against, so we need to make a new
// page.
page_t *page = make_page(0);
vec_append(&alloc->pages, &page, sizeof(page));
node = make_node(page, type);
end:
if (!node)
FAIL("Unexpected issue with allocating to a verifiably good page");
return tag_generic(node->data, type);
}
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);
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));
}
u64 alloc_cost(alloc_t *alloc)
{
u64 total_size = alloc->pages.size;
FOR_VEC(i, &alloc->pages, page_t *)
{
page_t *page = VEC_GET(&alloc->pages, i, page_t *);
total_size += page->data.size;
}
return total_size;
}
void alloc_free(alloc_t *alloc)
{
FOR_VEC(i, &alloc->pages, page_t *)
{
page_t *page = VEC_GET(&alloc->pages, i, page_t *);
// Iterate through every alloc_node in this page (dynamic walk)
for (u64 j = 0; j < VEC_SIZE(&page->data, u8);)
{
alloc_node_t *node = (alloc_node_t *)(vec_data(&page->data) + j);
u64 next = sizeof(*node) + tag_sizeof(node->metadata.tag);
static_assert(NUM_TAGS == 6);
switch (node->metadata.tag)
{
case TAG_CONS:
// Do nothing - will be cleaned by overall vec free anyway
break;
case TAG_VEC:
vec_free((vec_t *)node->data);
break;
case TAG_STR:
vec_free(&((str_t *)node->data)->data);
break;
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
default:
FAIL("Unreachable");
}
j += next;
}
// Each page was allocated on the heap.
vec_free(&page->data);
free(page);
}
vec_free(&alloc->pages);
vec_free(&alloc->free_vec);
memset(alloc, 0, sizeof(*alloc));
}
/* 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

@@ -9,105 +9,267 @@
#include <string.h> #include <string.h>
#include <alisp/lisp.h> #include <alisp/lisp.h>
#include <alisp/tag.h>
void sys_init(sys_t *sys) lisp_t *tag_smi(i64 i)
{ {
memset(sys, 0, sizeof(*sys)); return TAG(i, SMI);
} }
void sys_register(sys_t *sys, lisp_t *ptr) lisp_t *tag_sym(const char *str)
{ {
// Simply append it to the list of currently active conses return TAG(str, SYM);
vec_append(&sys->memory, &ptr, sizeof(&ptr));
} }
void sys_free(sys_t *sys) lisp_t *tag_vec(const vec_t *vec)
{ {
static_assert(NUM_TAGS == 5); return TAG(vec, VEC);
}
sym_table_cleanup(&sys->symtable); lisp_t *tag_str(const str_t *str)
if (sys->memory.size == 0) {
return; return TAG(str, STR);
}
// Iterate through each cell of memory currently allocated and free them lisp_t *tag_cons(const cons_t *cons)
for (size_t i = 0; i < VEC_SIZE(&sys->memory, lisp_t **); ++i)
{ {
lisp_t *allocated = VEC_GET(&sys->memory, i, lisp_t *); return TAG(cons, CONS);
switch (get_tag(allocated)) }
lisp_t *tag_generic(void *ptr, tag_t type)
{ {
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_NIL:
return TAG(ptr, NIL);
case TAG_SMI:
return tag_smi((i64)ptr);
case TAG_SYM:
return tag_sym(ptr);
case TAG_CONS: case TAG_CONS:
// Delete the cons return tag_cons(ptr);
free(as_cons(allocated)); case TAG_VEC:
return tag_vec(ptr);
case TAG_STR:
return tag_str(ptr);
default:
FAIL("Unreachable");
return NIL;
}
}
tag_t tag_get(const lisp_t *lisp)
{
return GET_TAG(lisp);
}
i64 as_smi(lisp_t *obj)
{
assert(IS_TAG(obj, SMI));
u64 raw_obj = UNTAG(obj);
u64 msb = (NTH_BYTE(raw_obj, 6) & 0x80) >> 7;
msb = ((1LU << 8) - msb) << 56;
return (i64)(raw_obj | msb);
}
char *as_sym(lisp_t *obj)
{
assert(IS_TAG(obj, SYM));
return (char *)UNTAG(obj);
}
cons_t *as_cons(lisp_t *obj)
{
assert(IS_TAG(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)
{
assert(IS_TAG(obj, VEC));
return (vec_t *)UNTAG(obj);
}
void lisp_print(FILE *fp, lisp_t *lisp)
{
if (!fp)
return;
static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{
case TAG_NIL:
fprintf(fp, "NIL");
break; break;
case TAG_SMI:
#if VERBOSE_LOGS == 2
fprintf(fp, "INT[");
#endif
fprintf(fp, "%ld", as_smi(lisp));
#if VERBOSE_LOGS == 2
fprintf(fp, "]");
#endif
break;
case TAG_SYM:
#if VERBOSE_LOGS == 2
fprintf(fp, "SYM[");
#endif
fprintf(fp, "%s", as_sym(lisp));
#if VERBOSE_LOGS == 2
fprintf(fp, "]");
#endif
break;
case TAG_CONS:
{
#if VERBOSE_LOGS == 2
fprintf(fp, "LIST[");
#else
fprintf(fp, "(");
#endif
for (; lisp; lisp = CDR(lisp))
{
if (IS_TAG(lisp, CONS))
{
lisp_t *car = CAR(lisp);
lisp_t *cdr = CDR(lisp);
lisp_print(fp, car);
if (cdr && !IS_TAG(cdr, CONS))
{
fprintf(fp, " . ");
}
else if (cdr)
{
fprintf(fp, " ");
}
}
else
{
lisp_print(fp, lisp);
break;
}
}
#if VERBOSE_LOGS == 2
fprintf(fp, "]");
#else
fprintf(fp, ")");
#endif
break;
}
case TAG_VEC: case TAG_VEC:
{ {
vec_t *vec = as_vec(allocated); #if VERBOSE_LOGS == 2
vec_free(vec); fprintf(fp, "VEC[");
free(vec); #else
fprintf(fp, "[");
#endif
vec_t *vec = as_vec(lisp);
FOR_VEC(i, vec, lisp_t *)
{
lisp_t *item = VEC_GET(vec, i, lisp_t *);
lisp_print(fp, item);
if (i < VEC_SIZE(vec, lisp_t *) - 1)
{
fprintf(fp, " ");
}
}
#if VERBOSE_LOGS == 2
fprintf(fp, "]");
#else
fprintf(fp, "]");
#endif
break; break;
} }
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:
FAIL("Unreachable");
break;
}
}
u64 tag_sizeof(tag_t tag)
{
static_assert(NUM_TAGS == 6);
switch (tag)
{
case TAG_NIL: case TAG_NIL:
case TAG_INT: return 0;
case TAG_SMI:
case TAG_SYM: case TAG_SYM:
case NUM_TAGS: return sizeof(lisp_t *);
// shouldn't be dealt with (either constant or dealt with elsewhere) case TAG_CONS:
break; return sizeof(cons_t);
case TAG_VEC:
return sizeof(vec_t);
case TAG_STR:
return sizeof(str_t);
default:
FAIL("Unreachable");
return 0;
} }
} }
// Free the container u64 lisp_sizeof(lisp_t *lisp)
vec_free(&sys->memory);
// 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); return tag_sizeof(tag_get(lisp));
} }
lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr) lisp_t *lisp_reset(lisp_t *lisp)
{ {
cons_t *cons = calloc(1, sizeof(*cons)); switch (tag_get(lisp))
cons->car = car; {
cons->cdr = cdr; case TAG_NIL:
case TAG_SMI:
lisp_t *lcons = tag_cons(cons); case TAG_SYM:
sys_register(sys, lcons); // Nothing to "reset" here.
return lcons; return lisp;
case TAG_CONS:
{
// Make `car` and `cons` NIL
CAR(lisp) = NIL;
CDR(lisp) = NIL;
return lisp;
} }
case TAG_VEC:
lisp_t *make_vec(sys_t *sys, u64 capacity)
{ {
vec_t *vec = calloc(1, sizeof(*vec)); vec_reset(as_vec(lisp));
vec_init(vec, capacity); return lisp;
lisp_t *ptr = tag_vec(vec);
sys_register(sys, ptr);
return ptr;
} }
case TAG_STR:
lisp_t *intern(sys_t *sys, sv_t sv)
{ {
char *str = sym_table_find(&sys->symtable, sv); vec_reset(&as_str(lisp)->data);
return tag_sym(str); return lisp;
} }
default:
lisp_t *car(lisp_t *lsp)
{ {
if (!IS_TAG(lsp, CONS)) FAIL("Unreachable");
return NIL; return lisp;
else }
return CAR(lsp);
} }
lisp_t *cdr(lisp_t *lsp)
{
if (!IS_TAG(lsp, CONS))
return NIL;
else
return CDR(lsp);
} }
/* Copyright (C) 2025, 2026 Aryadev Chavali /* Copyright (C) 2025, 2026 Aryadev Chavali

View File

@@ -11,43 +11,111 @@
#include <alisp/alisp.h> #include <alisp/alisp.h>
const char *TOKEN_DELIM = "\n "; void usage(FILE *fp);
int init_stream_on_args(int argc, char *argv[], FILE **pipe, stream_t *stream);
int main(void) int main(int argc, char *argv[])
{ {
sym_table_t table = {0}; int ret = 0;
sym_table_init(&table); FILE *pipe = NULL;
char filename[] = "./lorem.txt";
FILE *fp = fopen(filename, "r");
stream_t stream = {0}; stream_t stream = {0};
stream_init_file(&stream, filename, fp); vec_t ast = {0};
sys_t sys = {0};
for (u64 token_no = 1; !stream_eoc(&stream); ++token_no) ret = init_stream_on_args(argc, argv, &pipe, &stream);
if (ret)
goto end;
LOG("[INFO]: Initialised stream for `%s`\n", stream.name);
{ {
// Skip forward any delimiters read_err_t err = read_all(&sys, &stream, &ast);
stream_while(&stream, TOKEN_DELIM); if (err)
// Get the token (up until delimiter) {
sv_t token = stream_till(&stream, TOKEN_DELIM); u64 line = 0, col = 0;
char *interned = sym_table_find(&table, token); stream_line_col(&stream, &line, &col);
printf("%s[%lu] => `%s`\n", stream.name, token_no, interned); fprintf(stderr, "%s:%lu:%lu: ERROR: %s\n", stream.name, line, col,
read_err_to_cstr(err));
ret = 1;
goto end;
}
} }
printf("\nTable count=%lu\n", table.count); LOG("[INFO]: Utilised %lu bytes in parsing\n", sys_cost(&sys));
for (u64 i = 0, j = 0; i < table.capacity; ++i) LOG("[INFO]: Parsed %lu %s\n", VEC_SIZE(&ast, lisp_t *),
VEC_SIZE(&ast, lisp_t *) == 1 ? "expr" : "exprs");
{ {
sv_t token = VEC_GET(&table.entries, i, sv_t); FOR_VEC(i, &ast, lisp_t *)
if (!token.data) {
continue; #if VERBOSE_LOGS
printf("[%lu]@[%lu] => `" PR_SV "`\n", j, i, SV_FMT(token)); lisp_t *expr = VEC_GET(&ast, i, lisp_t *);
++j; printf("\t[%lu]: ", i);
lisp_print(stdout, expr);
printf("\n");
#endif
}
} }
stream_stop(&stream); end:
fclose(fp); sys_free(&sys);
sym_table_cleanup(&table); vec_free(&ast);
stream_free(&stream);
if (pipe)
fclose(pipe);
return ret;
}
int init_stream_on_args(int argc, char *argv[], FILE **pipe, stream_t *stream)
{
if (argc == 1)
{
usage(stderr);
return 1;
}
else if (argc != 2)
{
TODO("alisp doesn't support multiple files currently.");
}
if (strncmp(argv[1], "--", 2) == 0)
{
stream_err_t err = stream_init_pipe(stream, "stdin", stdin);
if (err)
{
fprintf(stderr, "ERROR: %s from `%s`\n", stream_err_to_cstr(err),
argv[1]);
return 1;
}
}
else if (strncmp(argv[1], "--help", 6) == 0)
{
usage(stdout);
return 0; return 0;
} }
else
{
*pipe = fopen(argv[1], "rb");
stream_err_t err = stream_init_file(stream, argv[1], *pipe);
if (err)
{
fprintf(stderr, "ERROR: %s from `%s`\n", stream_err_to_cstr(err),
argv[1]);
return 1;
}
}
return 0;
}
void usage(FILE *fp)
{
fprintf(fp, "Usage: alisp [OPTIONS...] FILE\n"
"Options:\n"
"\t--help Print this usage and exit.\n"
"File:\n"
"\t<filename> Read and interpret this file from filesystem.\n"
"\t-- Read and interpret from stdin using an EOF.\n");
}
/* Copyright (C) 2025, 2026 Aryadev Chavali /* Copyright (C) 2025, 2026 Aryadev Chavali

View File

@@ -8,7 +8,6 @@
#include <ctype.h> #include <ctype.h>
#include <string.h> #include <string.h>
#include <alisp/base.h>
#include <alisp/reader.h> #include <alisp/reader.h>
const char *read_err_to_cstr(read_err_t err) const char *read_err_to_cstr(read_err_t err)
@@ -17,18 +16,271 @@ const char *read_err_to_cstr(read_err_t err)
{ {
case READ_ERR_OK: case READ_ERR_OK:
return "OK"; return "OK";
break;
case READ_ERR_EOF: case READ_ERR_EOF:
return "EOF"; return "EOF";
break;
case READ_ERR_UNKNOWN_CHAR: case READ_ERR_UNKNOWN_CHAR:
return "UNKNOWN_CHAR"; return "UNKNOWN_CHAR";
break; case READ_ERR_EXPECTED_CLOSED_BRACE:
return "EXPECTED_CLOSED_BRACE";
case READ_ERR_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:
return "UNEXPECTED_CLOSED_BRACE";
case READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET:
return "UNEXPECTED_CLOSED_SQUARE_BRACKET";
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
} }
} }
// Accepted characters for symbols.
static const char *SYMBOL_CHARS =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!$%&*+,-./"
":<=>?@\\^_{|}~0123456789";
// Little predicate using SYMBOL_CHARS
bool is_sym(char c)
{
return strchr(SYMBOL_CHARS, c) != NULL;
}
void skip_comments_and_whitespace(stream_t *stream)
{
for (char c = stream_peek(stream); c != '\0' && (isspace(c) || c == ';');
c = stream_peek(stream))
{
stream_while(stream, " \t\n\0");
if (stream_peek(stream) == ';')
{
// Skip till newline
stream_till(stream, "\n");
}
}
}
read_err_t read_sym(sys_t *sys, stream_t *stream, lisp_t **ret)
{
sv_t sym_sv = stream_while(stream, SYMBOL_CHARS);
*ret = intern(sys, sym_sv);
return READ_ERR_OK;
}
read_err_t read_int(sys_t *sys, stream_t *stream, lisp_t **ret)
{
sv_t digits_sv = stream_while(stream, "0123456789");
if (is_sym(stream_peek(stream)))
{
// This is actually a symbol
stream_seek_backward(stream, digits_sv.size);
return read_sym(sys, stream, ret);
}
if (digits_sv.size >= 18)
{
TODO("alisp doesn't support big integers (bigger than 56 bits) yet");
}
i64 n = 0;
for (u64 i = 0; i < digits_sv.size; ++i)
{
char c = digits_sv.data[i];
u8 digit = c - '0';
// NOTE: 10i + digit > INT_MAX
// => 10i > INT_MAX - digit
// => i > (INT_MAX - digit) / 10
if (n > (INT_MAX - digit) / 10)
{
TODO("alisp doesn't support big integers (bigger than 56 bits) yet");
}
n *= 10;
n += digit;
}
*ret = make_int(n);
return READ_ERR_OK;
}
read_err_t read_negative(sys_t *sys, stream_t *stream, lisp_t **ret)
{
char c = stream_next(stream);
if (isdigit(c))
{
read_err_t err = read_int(sys, stream, ret);
if (err)
return err;
*ret = make_int(as_smi(*ret) * -1);
return READ_ERR_OK;
}
else if (is_sym(c) || isspace(c))
{
stream_seek_backward(stream, 1);
return read_sym(sys, stream, ret);
}
else
{
return READ_ERR_UNKNOWN_CHAR;
}
}
read_err_t read_list(sys_t *sys, stream_t *stream, lisp_t **ret)
{
u64 old_pos = stream->position;
// skip past the open parentheses '('
(void)stream_next(stream);
lisp_t *top = NIL;
lisp_t *cur = NIL;
while (!stream_eoc(stream) && stream_peek(stream) != ')')
{
lisp_t *item = NIL;
read_err_t err = read(sys, stream, &item);
if (err == READ_ERR_EOF)
{
goto no_close_brace;
}
else if (err)
{
return err;
}
else if (!top)
{
top = cons(sys, item, NIL);
cur = top;
}
else
{
as_cons(cur)->cdr = cons(sys, item, NIL);
cur = cdr(cur);
}
}
if (stream_peek(stream) != ')')
{
goto no_close_brace;
}
stream_next(stream);
*ret = top;
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)
{
u64 old_pos = stream->position;
(void)stream_next(stream);
lisp_t *container = make_vec(sys, 0);
while (!stream_eoc(stream) && stream_peek(stream) != ']')
{
lisp_t *item = NIL;
read_err_t err = read(sys, stream, &item);
if (err == READ_ERR_EOF)
{
goto no_close_square_bracket;
}
else if (err)
{
return err;
}
else
{
vec_append(as_vec(container), &item, sizeof(item));
}
}
if (stream_peek(stream) != ']')
goto no_close_square_bracket;
stream_next(stream);
*ret = container;
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)
{
lisp_t *to_quote = NIL;
stream_next(stream);
read_err_t err = read(sys, stream, &to_quote);
if (err)
return err;
lisp_t *items[] = {intern(sys, SV_AUTO("quote")), to_quote};
*ret = make_list(sys, items, ARRSIZE(items));
return READ_ERR_OK;
}
read_err_t read_all(sys_t *sys, stream_t *stream, vec_t *out)
{
while (!stream_eoc(stream))
{
lisp_t *item = NIL;
read_err_t err = read(sys, stream, &item);
if (err)
return err;
else
vec_append(out, &item, sizeof(item));
skip_comments_and_whitespace(stream);
}
return READ_ERR_OK;
}
read_err_t read(sys_t *sys, stream_t *stream, lisp_t **ret)
{
skip_comments_and_whitespace(stream);
if (stream_eoc(stream))
return READ_ERR_EOF;
char c = stream_peek(stream);
if (isdigit(c))
return read_int(sys, stream, ret);
else if (c == '-')
return read_negative(sys, stream, ret);
else if (is_sym(c))
return read_sym(sys, stream, ret);
else if (c == '\'')
return read_quote(sys, stream, ret);
else if (c == '(')
return read_list(sys, stream, ret);
else if (c == ')')
return READ_ERR_UNEXPECTED_CLOSED_BRACE;
else if (c == '[')
return read_vec(sys, stream, ret);
else if (c == ']')
return READ_ERR_UNEXPECTED_CLOSED_SQUARE_BRACKET;
else if (c == '\"')
return read_str(sys, stream, ret);
return READ_ERR_UNKNOWN_CHAR;
}
/* Copyright (C) 2026 Aryadev Chavali /* Copyright (C) 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT * This program is distributed in the hope that it will be useful, but WITHOUT

View File

@@ -5,11 +5,14 @@
* Commentary: * Commentary:
*/ */
#include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include <alisp/base.h> #include <alisp/base.h>
#include <alisp/stream.h> #include <alisp/stream.h>
#include <alisp/sv.h>
#include <alisp/vec.h>
const char *stream_err_to_cstr(stream_err_t err) const char *stream_err_to_cstr(stream_err_t err)
{ {
@@ -17,25 +20,21 @@ const char *stream_err_to_cstr(stream_err_t err)
{ {
case STREAM_ERR_INVALID_PTR: case STREAM_ERR_INVALID_PTR:
return "INVALID PTR"; return "INVALID PTR";
break;
case STREAM_ERR_FILE_NONEXISTENT: case STREAM_ERR_FILE_NONEXISTENT:
return "FILE NONEXISTENT"; return "FILE NONEXISTENT";
break;
case STREAM_ERR_FILE_READ: case STREAM_ERR_FILE_READ:
return "FILE READ"; return "FILE READ";
break;
case STREAM_ERR_PIPE_NONEXISTENT: case STREAM_ERR_PIPE_NONEXISTENT:
return "PIPE NONEXISTENT"; return "PIPE NONEXISTENT";
break;
case STREAM_ERR_OK: case STREAM_ERR_OK:
return "OK"; return "OK";
break;
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
} }
} }
stream_err_t stream_init_string(stream_t *stream, char *name, sv_t contents) stream_err_t stream_init_string(stream_t *stream, const char *name,
sv_t contents)
{ {
if (!stream) if (!stream)
return STREAM_ERR_INVALID_PTR; return STREAM_ERR_INVALID_PTR;
@@ -49,7 +48,7 @@ stream_err_t stream_init_string(stream_t *stream, char *name, sv_t contents)
return STREAM_ERR_OK; return STREAM_ERR_OK;
} }
stream_err_t stream_init_pipe(stream_t *stream, char *name, FILE *pipe) stream_err_t stream_init_pipe(stream_t *stream, const char *name, FILE *pipe)
{ {
if (!stream) if (!stream)
return STREAM_ERR_INVALID_PTR; return STREAM_ERR_INVALID_PTR;
@@ -63,12 +62,10 @@ stream_err_t stream_init_pipe(stream_t *stream, char *name, FILE *pipe)
stream->name = name; stream->name = name;
stream->pipe.file = pipe; stream->pipe.file = pipe;
vec_init(&stream->pipe.cache, STREAM_DEFAULT_CHUNK);
return STREAM_ERR_OK; return STREAM_ERR_OK;
} }
stream_err_t stream_init_file(stream_t *stream, char *name, FILE *pipe) stream_err_t stream_init_file(stream_t *stream, const char *name, FILE *pipe)
{ {
if (!stream) if (!stream)
return STREAM_ERR_INVALID_PTR; return STREAM_ERR_INVALID_PTR;
@@ -80,25 +77,41 @@ stream_err_t stream_init_file(stream_t *stream, char *name, FILE *pipe)
stream->type = STREAM_TYPE_FILE; stream->type = STREAM_TYPE_FILE;
stream->name = name; stream->name = name;
stream->pipe.file = pipe; stream->pipe.file = NULL;
vec_init(&stream->pipe.cache, STREAM_DEFAULT_CHUNK); // NOTE: We're reading all the data from the file descriptor now.
fseek(pipe, 0, SEEK_END);
long size = ftell(pipe);
fseek(pipe, 0, SEEK_SET);
vec_ensure_free(&stream->pipe.cache, size);
int read = fread(vec_data(&stream->pipe.cache), 1, size, pipe);
// These must be equivalent for this function.
assert(read == size);
stream->pipe.cache.size += size;
return STREAM_ERR_OK; return STREAM_ERR_OK;
} }
void stream_stop(stream_t *stream) void stream_reset(stream_t *stream)
{
if (!stream)
return;
stream->position = 0;
}
void stream_free(stream_t *stream)
{ {
if (!stream) if (!stream)
return; return;
switch (stream->type) switch (stream->type)
{ {
case STREAM_TYPE_STRING: case STREAM_TYPE_STRING:
free(stream->string.data); free((char *)stream->string.data);
break; break;
case STREAM_TYPE_PIPE:
case STREAM_TYPE_FILE: case STREAM_TYPE_FILE:
// Must cleanup vector case STREAM_TYPE_PIPE:
// Must cleanup caching vector
vec_free(&stream->pipe.cache); vec_free(&stream->pipe.cache);
break; break;
} }
@@ -121,31 +134,15 @@ u64 stream_size(stream_t *stream)
} }
} }
bool stream_eos(stream_t *stream)
{
assert(stream);
switch (stream->type)
{
case STREAM_TYPE_STRING:
return stream->position >= stream->string.size;
case STREAM_TYPE_PIPE:
case STREAM_TYPE_FILE:
return feof(stream->pipe.file);
default:
FAIL("Unreachable");
return 0;
}
}
bool stream_eoc(stream_t *stream) bool stream_eoc(stream_t *stream)
{ {
assert(stream); assert(stream);
switch (stream->type) switch (stream->type)
{ {
case STREAM_TYPE_STRING:
return stream->position >= stream->string.size;
case STREAM_TYPE_PIPE:
case STREAM_TYPE_FILE: case STREAM_TYPE_FILE:
case STREAM_TYPE_STRING:
return stream->position >= stream_size(stream);
case STREAM_TYPE_PIPE:
return feof(stream->pipe.file) && return feof(stream->pipe.file) &&
stream->position >= stream->pipe.cache.size; stream->position >= stream->pipe.cache.size;
default: default:
@@ -157,23 +154,20 @@ bool stream_eoc(stream_t *stream)
bool stream_chunk(stream_t *stream) bool stream_chunk(stream_t *stream)
{ {
assert(stream); assert(stream);
u64 to_read = STREAM_DEFAULT_CHUNK;
switch (stream->type) switch (stream->type)
{ {
case STREAM_TYPE_STRING:
// vacuously true
return true;
case STREAM_TYPE_PIPE:
to_read = 1;
// fallthrough
case STREAM_TYPE_FILE: case STREAM_TYPE_FILE:
case STREAM_TYPE_STRING:
// nothing to chunk, hence false
return false;
case STREAM_TYPE_PIPE:
{ {
if (feof(stream->pipe.file)) if (feof(stream->pipe.file))
// We can't read anymore. End of the line // We can't read anymore. End of the line
return false; return false;
vec_ensure_free(&stream->pipe.cache, to_read); vec_ensure_free(&stream->pipe.cache, STREAM_DEFAULT_CHUNK);
int read = fread(vec_data(&stream->pipe.cache) + stream->pipe.cache.size, 1, int read = fread(vec_data(&stream->pipe.cache) + stream->pipe.cache.size, 1,
to_read, stream->pipe.file); STREAM_DEFAULT_CHUNK, stream->pipe.file);
// If we read something it's a good thing // If we read something it's a good thing
if (read > 0) if (read > 0)
@@ -182,8 +176,10 @@ bool stream_chunk(stream_t *stream)
return true; return true;
} }
else else
{
return false; return false;
} }
}
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
return 0; return 0;
@@ -192,32 +188,27 @@ bool stream_chunk(stream_t *stream)
char stream_next(stream_t *stream) char stream_next(stream_t *stream)
{ {
char c = stream_peek(stream); if (stream_peek(stream) != '\0')
if (c != '\0')
++stream->position; ++stream->position;
return c; return stream_peek(stream);
} }
char stream_peek(stream_t *stream) char stream_peek(stream_t *stream)
{ {
// If we've reached end of stream, and end of content, there's really nothing // End of the line? We're done.
// to check here.
if (stream_eoc(stream)) if (stream_eoc(stream))
return '\0'; return '\0';
switch (stream->type) switch (stream->type)
{ {
case STREAM_TYPE_STRING:
return stream->string.data[stream->position];
case STREAM_TYPE_PIPE:
case STREAM_TYPE_FILE: case STREAM_TYPE_FILE:
case STREAM_TYPE_STRING:
return stream_sv(stream).data[0];
case STREAM_TYPE_PIPE:
{ {
// Cached already? We are done. // Cached already? We are done.
if (stream->position < stream->pipe.cache.size) if (stream->position < stream->pipe.cache.size)
{ return stream_sv(stream).data[0];
const char *const str = (char *)vec_data(&stream->pipe.cache);
return str[stream->position];
}
// Try to read chunks in till we've reached it or we're at the end of the // Try to read chunks in till we've reached it or we're at the end of the
// file. // file.
@@ -229,7 +220,7 @@ char stream_peek(stream_t *stream)
// Same principle as the stream_eos(stream) check. // Same principle as the stream_eos(stream) check.
if (stream->position >= stream->pipe.cache.size) if (stream->position >= stream->pipe.cache.size)
return '\0'; return '\0';
return ((char *)vec_data(&stream->pipe.cache))[stream->position]; return stream_sv(stream).data[0];
} }
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
@@ -237,43 +228,45 @@ char stream_peek(stream_t *stream)
} }
} }
bool stream_seek(stream_t *stream, i64 offset) u64 stream_seek(stream_t *stream, i64 offset)
{ {
if (offset < 0) if (offset < 0)
return stream_seek_backward(stream, offset * -1); return stream_seek_backward(stream, offset * -1);
else if (offset > 0) else if (offset > 0)
return stream_seek_forward(stream, offset); return stream_seek_forward(stream, offset);
else else
// vacuously successful return 0;
return true;
} }
bool stream_seek_forward(stream_t *stream, u64 offset) u64 stream_seek_forward(stream_t *stream, u64 offset)
{ {
if (stream_eoc(stream)) if (stream_eoc(stream))
return false; return 0;
else if (stream->position + offset < stream_size(stream))
{
stream->position += offset;
return offset;
}
// NOTE: The only case not caught by the above branches is exact-to-end
// movement (i.e. offset puts us exactly at the end of the stream) or movement
// beyond what we've cached.
switch (stream->type) switch (stream->type)
{ {
case STREAM_TYPE_FILE:
case STREAM_TYPE_STRING: case STREAM_TYPE_STRING:
{ {
if (stream->position + offset >= stream->string.size) // Clamp in the case of FILE and STRING movement since they're already
return false; // fully cached.
if (stream->position + offset >= stream_size(stream))
offset = stream_size(stream) - stream->position;
stream->position += offset; stream->position += offset;
return true; return offset;
} }
case STREAM_TYPE_PIPE: case STREAM_TYPE_PIPE:
case STREAM_TYPE_FILE:
{ {
// Similar principle as stream_peek really... // Pipes may have data remaining that hasn't been cached - we need to chunk
// before we can be sure to stop.
// Cached already? We are done.
if (stream->position + offset < stream->pipe.cache.size)
{
stream->position += offset;
return true;
}
// Try to read chunks in till we've reached it or we're at the end of the // Try to read chunks in till we've reached it or we're at the end of the
// file. // file.
@@ -282,25 +275,57 @@ bool stream_seek_forward(stream_t *stream, u64 offset)
read_chunk = stream_chunk(stream)) read_chunk = stream_chunk(stream))
continue; continue;
// Same principle as the stream_eoc(stream) check. // NOTE: We've read everything from the pipe, but the offset is greater. We
if (stream->position + offset > stream->pipe.cache.size) // must clamp here.
return false; if (stream->position + offset > stream_size(stream))
offset = stream_size(stream) - stream->position;
stream->position += offset; stream->position += offset;
return true; return offset;
} }
default: default:
FAIL("Unreachable"); FAIL("Unreachable");
}
return 0; return 0;
} }
u64 stream_seek_backward(stream_t *stream, u64 offset)
{
if (!stream)
return 0;
if (stream->position < offset)
offset = stream->position;
stream->position -= offset;
return offset;
} }
bool stream_seek_backward(stream_t *stream, u64 offset) sv_t stream_sv(stream_t *stream)
{ {
assert(stream); sv_t sv = stream_sv_abs(stream);
if (stream->position < offset) sv = sv_chop_left(sv, stream->position);
return false; return sv;
stream->position -= offset; }
return true;
sv_t stream_sv_abs(stream_t *stream)
{
if (!stream)
return SV(NULL, 0);
sv_t sv = {0};
switch (stream->type)
{
case STREAM_TYPE_STRING:
sv = stream->string;
break;
case STREAM_TYPE_FILE:
case STREAM_TYPE_PIPE:
sv = SV((char *)vec_data(&stream->pipe.cache), stream_size(stream));
break;
default:
FAIL("Unreachable");
return SV(NULL, 0);
}
return sv;
} }
sv_t stream_substr(stream_t *stream, u64 size) sv_t stream_substr(stream_t *stream, u64 size)
@@ -310,111 +335,137 @@ sv_t stream_substr(stream_t *stream, u64 size)
// See if I can go forward enough to make this substring // See if I can go forward enough to make this substring
u64 current_position = stream->position; u64 current_position = stream->position;
bool successful = stream_seek_forward(stream, size); u64 successful = stream_seek_forward(stream, size);
// Reset the position in either situation // Reset the position in either situation
stream->position = current_position; stream->position = current_position;
if (!successful) if (successful != size)
return SV(NULL, 0); return SV(NULL, 0);
char *ptr = NULL; sv_t sv = stream_sv(stream);
switch (stream->type) sv = sv_truncate(sv, size);
{ return sv;
case STREAM_TYPE_STRING:
ptr = stream->string.data;
break;
case STREAM_TYPE_PIPE:
case STREAM_TYPE_FILE:
ptr = (char *)vec_data(&stream->pipe.cache);
break;
default:
FAIL("Unreachable");
return SV(NULL, 0);
}
return SV(ptr + stream->position, size);
} }
sv_t stream_substr_abs(stream_t *stream, u64 index, u64 size) sv_t stream_substr_abs(stream_t *stream, u64 index, u64 size)
{ {
switch (stream->type) switch (stream->type)
{ {
case STREAM_TYPE_STRING:
if (index + size <= stream_size(stream))
return SV(stream->string.data + index, size);
return SV(NULL, 0);
case STREAM_TYPE_PIPE: case STREAM_TYPE_PIPE:
case STREAM_TYPE_FILE:
{ {
if (index + size <= stream_size(stream)) if (index + size > stream_size(stream))
return SV((char *)vec_data(&stream->pipe.cache) + index, size); {
// (index + size > stream_size(stream)) => try reading chunks // => try reading chunks till either we drop or we have enough space
for (bool read_chunk = stream_chunk(stream); for (bool read_chunk = stream_chunk(stream);
read_chunk && index + size >= stream->pipe.cache.size; read_chunk && index + size >= stream->pipe.cache.size;
read_chunk = stream_chunk(stream)) read_chunk = stream_chunk(stream))
continue; continue;
if (index + size > stream_size(stream))
return SV(NULL, 0);
return SV((char *)vec_data(&stream->pipe.cache) + index, size);
} }
break;
}
case STREAM_TYPE_STRING:
case STREAM_TYPE_FILE:
break;
default: default:
assert("Unreachable"); FAIL("Unreachable");
return SV(NULL, 0);
} }
sv_t sv = stream_sv_abs(stream);
sv = sv_chop_left(sv, index);
sv = sv_truncate(sv, size);
return sv;
} }
sv_t stream_till(stream_t *stream, const char *str) sv_t stream_till(stream_t *stream, const char *str)
{ {
if (stream_eoc(stream)) if (stream_eoc(stream))
return SV(NULL, 0); return SV(NULL, 0);
u64 current_position = stream->position;
for (char c = stream_peek(stream); c != '\0' && strchr(str, c) == NULL; sv_t cur_sv = stream_sv(stream);
c = stream_next(stream)) sv_t sv = sv_till(cur_sv, str);
continue; stream_seek_forward(stream, sv.size);
u64 size = stream->position - current_position; switch (stream->type)
if (size == 0) {
return SV(NULL, 0); case STREAM_TYPE_FILE:
return stream_substr_abs(stream, current_position, size - 1); case STREAM_TYPE_STRING:
return sv;
case STREAM_TYPE_PIPE:
{
if (cur_sv.size > sv.size)
return sv;
// Build a substring by hand while chunking data.
u64 index, size;
for (index = stream->position - sv.size, size = sv.size;
cur_sv.size == sv.size; size += sv.size)
{
cur_sv = stream_sv(stream);
sv = sv_till(cur_sv, str);
stream_seek_forward(stream, sv.size);
if (sv.size == 0)
// Must stop if this has happened; nothing else to pick up.
break;
}
return stream_substr_abs(stream, index, size);
}
default:
FAIL("Unreachable");
}
} }
sv_t stream_while(stream_t *stream, const char *str) sv_t stream_while(stream_t *stream, const char *str)
{ {
if (stream_eoc(stream)) if (stream_eoc(stream))
return SV(NULL, 0); return SV(NULL, 0);
u64 current_position = stream->position;
for (char c = stream_peek(stream); c != '\0' && strchr(str, c); sv_t cur_sv = stream_sv(stream);
c = stream_next(stream)) sv_t sv = sv_while(cur_sv, str);
continue; stream_seek_forward(stream, sv.size);
u64 size = stream->position - current_position; switch (stream->type)
if (size == 0) {
return SV(NULL, 0); case STREAM_TYPE_FILE:
return stream_substr_abs(stream, current_position, size - 1); case STREAM_TYPE_STRING:
return sv;
case STREAM_TYPE_PIPE:
{
if (cur_sv.size > sv.size)
return sv;
// Build a substring by hand while chunking data.
u64 index, size;
for (index = stream->position - sv.size, size = sv.size;
cur_sv.size == sv.size; size += sv.size)
{
cur_sv = stream_sv(stream);
sv = sv_while(cur_sv, str);
stream_seek_forward(stream, sv.size);
if (sv.size == 0)
// Must stop if this has happened; nothing else to pick up.
break;
}
return stream_substr_abs(stream, index, size);
}
default:
FAIL("Unreachable");
}
} }
void stream_line_col(stream_t *stream, u64 *line, u64 *col) void stream_line_col(stream_t *stream, u64 *line, u64 *col)
{ {
if (!stream || !line || !col) if (!stream || !line || !col)
return; return;
// Go through the cache, byte by byte.
char *cache = NULL; // Generate a string view from the stream of exactly the content /upto/
u64 size = 0; // stream.postion.
if (stream->type == STREAM_TYPE_STRING) sv_t sv = stream_sv_abs(stream);
{ sv = sv_truncate(sv, stream->position + 1);
cache = stream->string.data;
size = stream->string.size;
}
else
{
cache = (char *)vec_data(&stream->pipe.cache);
size = stream->pipe.cache.size;
}
*line = 1; *line = 1;
*col = 0; *col = 0;
for (u64 i = 0; i < size; ++i) // TODO: Could this be faster? Does it matter?
for (u64 i = 0; i < sv.size; ++i)
{ {
char c = cache[i]; char c = sv.data[i];
if (c == '\n') if (c == '\n')
{ {
*line += 1; *line += 1;

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

@@ -12,12 +12,69 @@
sv_t sv_copy(sv_t old) sv_t sv_copy(sv_t old)
{ {
if (old.size == 0)
return SV(old.data, 0);
else if (old.data == NULL)
return SV(NULL, old.size);
char *newstr = calloc(1, (old.size + 1) * sizeof(*newstr)); char *newstr = calloc(1, (old.size + 1) * sizeof(*newstr));
memcpy(newstr, old.data, old.size); memcpy(newstr, old.data, old.size);
newstr[old.size] = '\0'; newstr[old.size] = '\0';
return SV(newstr, old.size); return SV(newstr, old.size);
} }
sv_t sv_chop_left(sv_t sv, u64 size)
{
if (sv.size <= size)
return SV(NULL, 0);
return SV(sv.data + size, sv.size - size);
}
sv_t sv_chop_right(sv_t sv, u64 size)
{
if (sv.size <= size)
return SV(NULL, 0);
return SV(sv.data, sv.size - size);
}
sv_t sv_truncate(sv_t sv, u64 newsize)
{
if (newsize > sv.size)
return SV(NULL, 0);
return SV(sv.data, newsize);
}
sv_t sv_substr(sv_t sv, u64 position, u64 size)
{
sv_t result = sv_truncate(sv_chop_left(sv, position), size);
return result;
}
sv_t sv_till(sv_t sv, const char *reject)
{
if (sv.size == 0 || !sv.data)
return SV(NULL, 0);
u64 offset;
for (offset = 0; offset < sv.size && strchr(reject, sv.data[offset]) == NULL;
++offset)
continue;
return sv_truncate(sv, offset);
}
sv_t sv_while(sv_t sv, const char *accept)
{
if (sv.size == 0 || !sv.data)
return SV(NULL, 0);
u64 offset;
for (offset = 0; offset < sv.size && strchr(accept, sv.data[offset]) != NULL;
++offset)
continue;
return sv_truncate(sv, offset);
}
/* Copyright (C) 2025, 2026 Aryadev Chavali /* Copyright (C) 2025, 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT * This program is distributed in the hope that it will be useful, but WITHOUT

View File

@@ -29,7 +29,7 @@ void sym_table_init(sym_table_t *table)
vec_init(&table->entries, table->capacity * sizeof(sv_t)); vec_init(&table->entries, table->capacity * sizeof(sv_t));
} }
char *sym_table_find(sym_table_t *table, sv_t sv) const char *sym_table_find(sym_table_t *table, sv_t sv)
{ {
// Initialise the table if it's not done already // Initialise the table if it's not done already
if (table->entries.capacity == 0) if (table->entries.capacity == 0)
@@ -54,7 +54,7 @@ char *sym_table_find(sym_table_t *table, sv_t sv)
return ENTRY_GET(table, index).data; return ENTRY_GET(table, index).data;
} }
void sym_table_cleanup(sym_table_t *table) void sym_table_free(sym_table_t *table)
{ {
// Iterate through the strings and free each of them. // Iterate through the strings and free each of them.
sv_t current = {0}; sv_t current = {0};
@@ -62,13 +62,29 @@ void sym_table_cleanup(sym_table_t *table)
{ {
current = ENTRY_GET(table, i); current = ENTRY_GET(table, i);
if (current.data) if (current.data)
free(current.data); {
// NOTE: We clone all data here, so it's okay to free by hand.
free((void *)current.data);
}
} }
// Free the underlying container // Free the underlying container
vec_free(&table->entries); vec_free(&table->entries);
memset(table, 0, sizeof(*table)); memset(table, 0, sizeof(*table));
} }
u64 sym_table_cost(sym_table_t *table)
{
if (!table || !table->count)
return 0;
else
{
u64 total_size = 0;
for (u64 i = 0; i < table->capacity; ++i)
total_size += ENTRY_GET(table, i).size;
return total_size;
}
}
/* Copyright (C) 2025, 2026 Aryadev Chavali /* Copyright (C) 2025, 2026 Aryadev Chavali
* This program is distributed in the hope that it will be useful, but WITHOUT * This program is distributed in the hope that it will be useful, but WITHOUT

180
src/sys.c Normal file
View File

@@ -0,0 +1,180 @@
/* 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)
{
static_assert(NUM_TAGS == 6);
switch (type)
{
case TAG_CONS:
case TAG_VEC:
case TAG_STR:
return alloc_make(&sys->memory, type);
// Shouldn't be allocated
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
default:
FAIL("Unreachable");
}
return NIL;
}
void sys_delete(sys_t *sys, lisp_t *lisp)
{
alloc_delete(&sys->memory, lisp);
}
u64 sys_cost(sys_t *sys)
{
return alloc_cost(&sys->memory) + sym_table_cost(&sys->symtable);
}
void sys_free(sys_t *sys)
{
sym_table_free(&sys->symtable);
alloc_free(&sys->memory);
memset(sys, 0, sizeof(*sys));
}
lisp_t *make_int(i64 i)
{
return tag_smi(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_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 *vec = sys_alloc(sys, TAG_VEC);
vec_init(as_vec(vec), capacity);
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)
{
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(sys_t *sys, lisp_t *lisp)
{
static_assert(NUM_TAGS == 6);
switch (tag_get(lisp))
{
case TAG_STR:
case TAG_VEC:
case TAG_CONS:
// Delete the underlying data
alloc_delete(&sys->memory, lisp);
break;
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
// shouldn't be dealt with (either constant or dealt with elsewhere)
break;
}
}
void lisp_free_rec(sys_t *sys, lisp_t *item)
{
static_assert(NUM_TAGS == 6);
switch (tag_get(item))
{
case TAG_CONS:
{
lisp_free_rec(sys, car(item));
lisp_free_rec(sys, cdr(item));
lisp_free(sys, item);
break;
}
case TAG_VEC:
{
vec_t *vec = as_vec(item);
FOR_VEC(i, vec, lisp_t *)
{
lisp_t *allocated = VEC_GET(vec, i, lisp_t *);
lisp_free_rec(sys, allocated);
}
lisp_free(sys, item);
break;
}
case TAG_STR:
{
lisp_free(sys, item);
break;
}
case TAG_NIL:
case TAG_SMI:
case TAG_SYM:
// 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/>.
*/

View File

@@ -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/tag.h>
lisp_t *tag_int(i64 i)
{
return TAG((u64)i, INT);
}
lisp_t *tag_sym(char *str)
{
return TAG((u64)str, SYM);
}
lisp_t *tag_vec(vec_t *vec)
{
return TAG((u64)vec, VEC);
}
lisp_t *tag_cons(cons_t *cons)
{
return TAG((u64)cons, CONS);
}
tag_t get_tag(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/>.
*/

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;
@@ -81,10 +89,24 @@ void vec_append(vec_t *vec, const void *const ptr, u64 size)
if (!vec) if (!vec)
return; return;
vec_ensure_free(vec, size); vec_ensure_free(vec, size);
if (ptr)
memcpy(vec_data(vec) + vec->size, ptr, size); memcpy(vec_data(vec) + vec->size, ptr, size);
vec->size += size; vec->size += size;
} }
bool vec_try_append(vec_t *vec, const void *const ptr, u64 size)
{
if (!vec || vec->capacity - vec->size < size)
return false;
if (ptr)
{
void *newptr = vec_data(vec) + vec->size;
memcpy(newptr, ptr, size);
}
vec->size += size;
return true;
}
void vec_clone(vec_t *dest, vec_t *src) void vec_clone(vec_t *dest, vec_t *src)
{ {
if (!src || !dest) if (!src || !dest)

View File

@@ -6,28 +6,33 @@
*/ */
#include <stdio.h> #include <stdio.h>
#include <stdlib.h>
#include <string.h> #include <string.h>
#include <time.h>
#include "./data.h" #include "./data.h"
#include "./test.h" #include "./test.h"
#include "./test_lisp_api.c" #include "./test_lisp_api.c"
#include "./test_stream.c"
#include "./test_sv.c"
#include "./test_symtable.c"
#include "./test_vec.c" #include "./test_vec.c"
test_suite_t SUITES[] = { test_suite_t SUITES[] = {
LISP_API_SUITE, SV_SUITE, VEC_SUITE, SYMTABLE_SUITE, STREAM_SUITE, LISP_API_SUITE,
VEC_SUITE,
}; };
int main(void) int main(void)
{ {
// Seed the pseudorandom gen for subsequent tests.
srand(time(NULL));
for (u64 i = 0; i < ARRSIZE(SUITES); ++i) for (u64 i = 0; i < ARRSIZE(SUITES); ++i)
{ {
test_suite_t suite = SUITES[i]; test_suite_t suite = SUITES[i];
printf("Suite [%s]\n", suite.name); printf("Suite [%s]\n", suite.name);
for (u64 j = 0; j < suite.size; ++j) for (u64 j = 0; j < suite.size; ++j)
{ {
printf("[%s]: Running...\n", suite.tests[j].name);
suite.tests[j].fn(); suite.tests[j].fn();
} }
} }

View File

@@ -10,27 +10,50 @@
#include <alisp/alisp.h> #include <alisp/alisp.h>
#define TEST_PASSED() printf("[%s]: Passed\n", __func__) #ifndef TEST_VERBOSE
#define TEST_VERBOSE 0
#endif
#define TEST_END() printf("\t[%s]: Passed\n", __func__)
#define TEST_INFO(...) \
do \
{ \
printf("\tINFO: "); \
printf(__VA_ARGS__); \
} while (0);
#if TEST_VERBOSE
#define TEST_START() printf("\t[%s]: Running...\n", __func__)
#define TEST(COND, ...) \ #define TEST(COND, ...) \
do \ do \
{ \ { \
bool cond = (COND); \ bool cond = (COND); \
if (!cond) \ if (!cond) \
{ \ { \
printf("\tFAIL: "); \ printf("\t\tFAIL: "); \
} \ } \
else \ else \
{ \ { \
printf("\tPASS: "); \ printf("\t\tPASS: "); \
} \ } \
printf("%s => ", #COND); \
printf(__VA_ARGS__); \ printf(__VA_ARGS__); \
printf("\n"); \ printf("\n\t\t [%s]\n", #COND); \
if (!cond) \ if (!cond) \
{ \ { \
assert(0); \ assert(0); \
} \ } \
} while (0) } while (0)
#else
#define TEST_START()
#define TEST(COND, ...) \
do \
{ \
if (!(COND)) \
{ \
assert(0); \
} \
} while (0)
#endif
typedef struct TestFn typedef struct TestFn
{ {
@@ -47,8 +70,13 @@ typedef struct
const u64 size; const u64 size;
} test_suite_t; } test_suite_t;
#define MAKE_TEST_SUITE(NAME) \ #define MAKE_TEST_SUITE(NAME, DESC, ...) \
{.name = #NAME, .tests = NAME, .size = ARRSIZE(NAME)} const test_fn NAME##_TESTS[] = {__VA_ARGS__}; \
const test_suite_t NAME = { \
.name = DESC, \
.tests = NAME##_TESTS, \
.size = ARRSIZE(NAME##_TESTS), \
}
#endif #endif

View File

@@ -10,8 +10,11 @@
#include <alisp/lisp.h> #include <alisp/lisp.h>
void int_test(void) void smi_test(void)
{ {
TEST_START();
// Standard old testing, checking both sides of the number line and our set
// bounds.
i64 ints[] = { i64 ints[] = {
1, -1, (1 << 10) - 1, (-1) * ((1 << 10) - 1), INT_MIN, INT_MAX, 1, -1, (1 << 10) - 1, (-1) * ((1 << 10) - 1), INT_MIN, INT_MAX,
}; };
@@ -20,36 +23,46 @@ void int_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);
} }
TEST_PASSED(); TEST_END();
} }
void symtable_test(void) void smi_oob_test(void)
{ {
sym_table_t table = {0}; TEST_START();
sym_table_init(&table); // These are integers that are completely out of the bounds of our standard
for (u64 i = 0; i < ARRSIZE(words); ++i) // tagging system due to their size. We need to use big integers for this.
sym_table_find(&table, SV((char *)words[i], strlen(words[i]))); i64 ints[] = {
INT_MIN - 1,
INT_MAX + 1,
INT64_MIN,
INT64_MAX,
};
TEST(table.count == ARRSIZE(unique_words), "%lu == %lu", table.count, for (u64 i = 0; i < ARRSIZE(ints); ++i)
ARRSIZE(unique_words)); {
i64 in = ints[i];
lisp_t *lisp = make_int(in);
i64 out = as_smi(lisp);
TEST(table.count < ARRSIZE(unique_words), "%lu < %lu", table.count, TEST(in != out, "%ld != %ld", in, out);
ARRSIZE(unique_words));
TEST_PASSED();
sym_table_cleanup(&table);
} }
void sym_test(void) TEST_END();
}
void sym_fresh_test(void)
{ {
TEST_START();
sys_t system = {0}; sys_t system = {0};
sys_init(&system); sys_init(&system);
// We expect every interned symbol to get a fresh allocation, but still be a
// valid representation of the original symbol.
for (u64 i = 0; i < ARRSIZE(words); ++i) for (u64 i = 0; i < ARRSIZE(words); ++i)
{ {
const char *in = words[i]; const char *in = words[i];
@@ -57,14 +70,48 @@ void sym_test(void)
char *out = as_sym(lisp); char *out = as_sym(lisp);
TEST(in != out, "%p != %p", in, out); TEST(in != out, "%p != %p", in, out);
TEST(strlen(in) == strlen(out), "%zu == %zu", strlen(in), strlen(out)); TEST(strlen(in) == strlen(out), "%zu == %zu", strlen(in), strlen(out));
TEST(strncmp(in, out, strlen(in)) == 0, "%d", strncmp(in, out, strlen(in))); TEST(strncmp(in, out, strlen(in)) == 0, "`%s` == `%s`", in, out);
} }
TEST_PASSED();
sys_free(&system); sys_free(&system);
TEST_END();
}
void sym_unique_test(void)
{
TEST_START();
sys_t system = {0};
sys_init(&system);
sv_t symbols[] = {
SV_AUTO("hello"),
SV_AUTO("goodbye"),
SV_AUTO("display"),
SV_AUTO("@xs'a_sh;d::a-h]"),
};
lisp_t *ptrs[ARRSIZE(symbols)];
for (u64 i = 0; i < ARRSIZE(symbols); ++i)
{
ptrs[i] = intern(&system, symbols[i]);
TEST(ptrs[i] != 0, "%p (derived from `" PR_SV "`) is not NIL",
(void *)ptrs[i], SV_FMT(symbols[i]));
}
for (u64 i = 0; i < ARRSIZE(symbols); ++i)
{
lisp_t *newptr = intern(&system, symbols[i]);
TEST(newptr == ptrs[i], "interning again (%p) gives us the same (%p)",
(void *)newptr, (void *)ptrs[i]);
}
sys_free(&system);
TEST_END();
} }
void cons_test(void) void cons_test(void)
{ {
TEST_START();
sys_t system = {0}; sys_t system = {0};
sys_init(&system); sys_init(&system);
@@ -77,7 +124,13 @@ void cons_test(void)
lisp = cons(&system, lword, lisp); lisp = cons(&system, lword, lisp);
} }
// Make sure we've essentially reversed the `words` array /*
As we've cons'd each word, we'd expect the order to be reversed. This test
will allow us to verify:
1) words have actually been added to the linked list.
2) words are in the order we expect.
in one go.
*/
u64 i = ARRSIZE(words); u64 i = ARRSIZE(words);
for (lisp_t *iter = lisp; iter; iter = cdr(iter), --i) for (lisp_t *iter = lisp; iter; iter = cdr(iter), --i)
{ {
@@ -89,22 +142,59 @@ void cons_test(void)
TEST(strncmp(expected, got, size) == 0, "%s == %s", expected, got); TEST(strncmp(expected, got, size) == 0, "%s == %s", expected, got);
} }
TEST_PASSED();
sys_free(&system); sys_free(&system);
TEST_END();
} }
const test_fn TESTS_LISP_API[] = { void sys_test(void)
MAKE_TEST_FN(int_test), {
MAKE_TEST_FN(sym_test), TEST_START();
MAKE_TEST_FN(cons_test), sys_t sys = {0};
}; sys_init(&sys);
u64 old_memory_size = sys_cost(&sys);
const test_suite_t LISP_API_SUITE = { // Creating integers doesn't affect memory size
.name = "Lisp API Tests", (void)make_int(2000);
.tests = TESTS_LISP_API, TEST(sys_cost(&sys) == old_memory_size,
.size = ARRSIZE(TESTS_LISP_API), "Making integers doesn't affect system memory size");
};
// Creating symbols does affect memory size and memory table
(void)intern(&sys, SV_AUTO("hello world!"));
TEST(sys_cost(&sys) > old_memory_size,
"Interning doesn't affect system memory size");
TEST(sys.symtable.count > 0, "Interning affects symbol table");
old_memory_size = sys_cost(&sys);
// Creating conses do affect memory size
(void)cons(&sys, make_int(1), make_int(2));
TEST(sys_cost(&sys) > 0, "Creating conses affects memory size");
old_memory_size = sys_cost(&sys);
(void)cons(&sys, intern(&sys, SV_AUTO("test")), NIL);
TEST(sys_cost(&sys) > old_memory_size,
"Creating conses back to back affects memory size");
old_memory_size = sys_cost(&sys);
// Creating vectors does affect memory size
(void)make_vec(&sys, 8);
TEST(sys_cost(&sys) > old_memory_size,
"Creating vectors (size 8) affects memory size");
old_memory_size = sys_cost(&sys);
(void)make_vec(&sys, 1000);
TEST(sys_cost(&sys) > old_memory_size,
"Creating vectors (size 1000) affects memory size");
old_memory_size = sys_cost(&sys);
sys_free(&sys);
TEST_END();
}
MAKE_TEST_SUITE(LISP_API_SUITE, "LISP API Tests",
MAKE_TEST_FN(smi_test), MAKE_TEST_FN(smi_oob_test),
MAKE_TEST_FN(sym_fresh_test), MAKE_TEST_FN(sym_unique_test),
MAKE_TEST_FN(cons_test), MAKE_TEST_FN(sys_test), );
/* Copyright (C) 2026 Aryadev Chavali /* Copyright (C) 2026 Aryadev Chavali

424
test/test_stream.c Normal file
View File

@@ -0,0 +1,424 @@
/* test_stream.c: Stream tests
* Created: 2026-02-05
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include <malloc.h>
#include <stdio.h>
#include "./data.h"
#include "./test.h"
#include <alisp/stream.h>
#include <string.h>
char valid_filename[50];
FILE *valid_fp = NULL;
FILE *invalid_fp = NULL;
void stream_test_prologue(void)
{
const char filename_prefix[] = "build/stream_test_";
valid_filename[ARRSIZE(valid_filename) - 1] = '\0';
memcpy(valid_filename, filename_prefix, ARRSIZE(filename_prefix) - 1);
for (u64 i = ARRSIZE(filename_prefix) - 1; i < ARRSIZE(valid_filename) - 1;
++i)
{
u8 num = (rand() % 36);
if (num < 26)
{
valid_filename[i] = num + 'a';
}
else
{
valid_filename[i] = num + '0';
}
}
TEST_INFO("Creating file named `%.*s`\n", (int)ARRSIZE(valid_filename),
valid_filename);
valid_fp = fopen(valid_filename, "wb");
// This should do a few things for us
// 1) Create a file, or clear the contents of it if it exists already.
// 2) Write some content to it.
assert(valid_fp);
fwrite(words_text, ARRSIZE(words_text) - 1, 1, valid_fp);
fclose(valid_fp);
valid_fp = fopen(valid_filename, "rb");
assert(valid_fp);
invalid_fp = NULL;
}
void stream_test_epilogue(void)
{
TEST_INFO("Deleting file `%s`\n", valid_filename);
assert(valid_fp);
fclose(valid_fp);
remove(valid_filename);
}
void stream_test_string(void)
{
TEST_START();
sv_t test_strings[] = {
SV_AUTO("hello, world!"),
SV_AUTO("another string"),
sv_truncate(SV_AUTO(text), ARRSIZE(text) / 2),
};
for (u64 i = 0; i < ARRSIZE(test_strings); ++i)
{
sv_t copy = sv_copy(test_strings[i]);
stream_t stream = {0};
stream_err_t err = stream_init_string(&stream, NULL, test_strings[i]);
TEST(err == STREAM_ERR_OK, "Stream initialising did not fail: %s",
stream_err_to_cstr(err));
TEST(stream_size(&stream) == test_strings[i].size,
"Stream size is always string size (%lu == %lu)", stream_size(&stream),
test_strings[i].size);
TEST(!stream_eoc(&stream), "Not end of content already");
stream_free(&stream);
TEST(strncmp(copy.data, test_strings[i].data, copy.size) == 0,
"Freeing a stream does not free the underlying memory it was derived "
"from");
// NOTE: Okay to free since we own copy.
free((void *)copy.data);
}
stream_t stream = {0};
stream_err_t err = stream_init_string(&stream, NULL, SV(NULL, 0));
TEST(err == STREAM_ERR_OK, "NULL stream initialising did not fail: %s",
stream_err_to_cstr(err));
TEST(stream_size(&stream) == 0, "NULL stream size is 0");
TEST(stream_eoc(&stream), "NULL stream is always at end of content");
stream_free(&stream);
TEST_END();
}
void stream_test_file(void)
{
TEST_START();
// Test that initialising works correctly
{
stream_t stream = {0};
{
stream_err_t err = stream_init_file(&stream, valid_filename, valid_fp);
TEST(err == STREAM_ERR_OK, "Expected initialisating to be okay: %s",
stream_err_to_cstr(err));
}
TEST(!stream_eoc(&stream), "Stream should not be at the EoC from init.");
stream_free(&stream);
}
// try to initialise the stream again but against a nonexistent file - we're
// expecting an error.
{
stream_t stream = {0};
{
stream_err_t err = stream_init_file(&stream, NULL, invalid_fp);
TEST(err != STREAM_ERR_OK, "Expected initialisating to not be okay: %s",
stream_err_to_cstr(err));
}
}
TEST_END();
}
void stream_test_peek_next(void)
{
TEST_START();
// Valid streams
{
stream_t stream = {0};
stream_init_file(&stream, valid_filename, valid_fp);
u64 old_position = stream.position;
char c1 = stream_peek(&stream);
TEST(c1 != '\0', "Peek should provide a normal character (%c)", c1);
TEST(stream.position == old_position,
"Peek should not shift the position (%lu -> %lu)", old_position,
stream.position);
char c2 = stream_next(&stream);
TEST(c2 != '\0', "Next should provide a normal character (%c)", c2);
TEST(stream.position > old_position,
"Next should shift the position (%lu -> %lu)", old_position,
stream.position);
TEST(c2 != c1,
"Next should yield a different character (%c) to the previous peek "
"(%c)",
c2, c1);
char c3 = stream_peek(&stream);
TEST(c3 == c2,
"Peeking should yield the same character (%c) as the previous next "
"(%c)",
c3, c2);
stream_free(&stream);
}
// Invalid streams
{
stream_t stream = {0};
stream_init_file(&stream, NULL, invalid_fp);
char c = stream_peek(&stream);
TEST(c == '\0', "Invalid streams should have an invalid peek (%c)", c);
u64 old_position = stream.position;
c = stream_next(&stream);
TEST(c == '\0', "Invalid streams should have an invalid next (%c)", c);
TEST(old_position == stream.position,
"Next on an invalid stream should not affect position (%lu -> %lu)",
old_position, stream.position);
stream_free(&stream);
}
TEST_END();
}
void stream_test_seek(void)
{
TEST_START();
// Seeking on invalid streams
{
stream_t stream = {0};
stream_init_file(&stream, NULL, invalid_fp);
u64 old_position = stream.position;
TEST(!stream_seek_forward(&stream, 1),
"Shouldn't be possible to seek forward on an invalid stream.");
TEST(old_position == stream.position,
"Position shouldn't be affected when seeking forward on an invalid "
"stream"
"(%lu -> %lu)",
old_position, stream.position);
TEST(!stream_seek_backward(&stream, 1),
"Shouldn't be possible to seek backward on an invalid stream.");
TEST(old_position == stream.position,
"Position shouldn't be affected when seeking backward on an invalid "
"stream (%lu -> %lu)",
old_position, stream.position);
stream_free(&stream);
}
// Valid streams
{
stream_t stream = {0};
stream_init_file(&stream, valid_filename, valid_fp);
u64 old_position = stream.position;
TEST(stream_seek_forward(&stream, 1),
"Okay to seek forward on a valid stream.");
TEST(old_position < stream.position,
"Position should be greater than before when seeking forward on a "
"valid stream (%lu -> %lu)",
old_position, stream.position);
TEST(stream_seek_backward(&stream, 1),
"Okay to seek backward on a valid stream.");
TEST(old_position == stream.position,
"stream_seek_forward and stream_seek_backward are inverse operations");
u64 forward_offset = stream_seek_forward(&stream, ARRSIZE(words_text) * 2);
TEST(forward_offset < ARRSIZE(words_text) * 2,
"Forward seeking by offsets greater than file size clamps (%lu "
"clamps to %lu)",
ARRSIZE(words_text) * 2, forward_offset);
u64 file_size = stream_size(&stream);
u64 backward_offset = stream_seek_backward(&stream, file_size + 1);
TEST(backward_offset == file_size,
"Backward seeking by offsets greater than file size clamps (%lu "
"clamps to %lu)",
file_size + 1, backward_offset);
TEST(stream.position == 0,
"Clamped forward and clamped backward seeking "
"leads to start of stream (position=%lu)",
stream.position);
i64 r_forward_offset = (rand() % (file_size - 1)) + 1;
i64 r_backward_offset = (rand() % (file_size - 1)) + 1;
while (r_backward_offset >= r_forward_offset)
r_backward_offset = (rand() % (file_size - 1)) + 1;
TEST(stream_seek(&stream, r_forward_offset) == (u64)r_forward_offset,
"Seeking by a random positive offset (%lu) is valid",
r_forward_offset);
TEST(stream_seek(&stream, -r_backward_offset) == (u64)r_backward_offset,
"Seeking backward by a random negative offset (%lu) is valid",
r_backward_offset);
TEST(
(i64)stream.position == r_forward_offset - r_backward_offset,
"Stream position (%lu) is exactly shifted by seeking offsets described "
"above.",
stream.position);
stream_free(&stream);
}
TEST_END();
}
void stream_test_substr(void)
{
TEST_START();
u64 size = rand() % (ARRSIZE(words_text) - 1);
u64 position = ARRSIZE(words_text) - size - 1;
// Taking substrings of invalid streams
{
stream_t stream = {0};
stream_init_file(&stream, NULL, invalid_fp);
// Relative
{
sv_t result = stream_substr(&stream, size);
TEST(result.data == NULL && result.size == 0,
"Relative substring with size %lu on invalid stream should be NULL",
size);
}
// Absolute
{
sv_t result = stream_substr_abs(&stream, position, size);
TEST(result.data == NULL && result.size == 0,
"Absolute substring @%lu with size %lu on invalid stream should be "
"NULL",
position, size);
}
stream_free(&stream);
}
// Taking substrings of valid streams
{
stream_t stream = {0};
stream_init_file(&stream, valid_filename, valid_fp);
// Absolute
{
sv_t result = stream_substr_abs(&stream, position, size);
TEST(result.data && result.size,
"Absolute substring @%lu with size %lu on valid stream should be "
"nonzero",
position, size);
TEST(result.size == size, "Substring has right size (%lu)", result.size);
sv_t expected = sv_substr(SV_AUTO(words_text), position, size);
TEST(strncmp(result.data, expected.data, result.size) == 0,
"Expect the substring to be the same as the data we put in");
}
// Relative
{
sv_t result = stream_substr(&stream, size);
TEST(result.data && result.size,
"Relative substring with size %lu should be nonzero", size);
TEST(result.size == size, "Substring has right size (%lu)", result.size);
sv_t expected = sv_truncate(SV_AUTO(words_text), size);
TEST(strncmp(result.data, expected.data, result.size) == 0,
"Expect the substring to be the same as the data we put in");
}
// Relative substring after seeking
{
// Shift forward to a random position
assert(stream_seek_forward(&stream, position)); // not a test
sv_t result = stream_substr(&stream, size);
TEST(result.data && result.size,
"Relative substring with size %lu after seeking %lu bytes should be "
"nonzero",
size, position);
TEST(result.size == size, "Substring has right size (%lu)", result.size);
sv_t expected = sv_substr(SV_AUTO(words_text), position, size);
TEST(strncmp(result.data, expected.data, result.size) == 0,
"Expect the substring to be the same as the data we put in");
// Shift back to the original position.
assert(stream_seek_backward(&stream, position)); // not a test
}
// Bad substrings
{
{
sv_t result = stream_substr_abs(&stream, stream_size(&stream), 100);
TEST(!result.data && !result.size,
"Absolute substring at %lu of 100 bytes is invalid",
stream_size(&stream));
}
assert(stream_seek_forward(&stream, stream_size(&stream))); // not a test
{
sv_t result = stream_substr(&stream, 100);
TEST(!result.data && !result.size,
"Relative substring with size 100 after seeking %lu bytes is "
"invalid",
stream.position);
}
}
stream_free(&stream);
}
TEST_END();
}
void stream_test_till(void)
{
TEST_START();
TODO("Not implemented");
}
void stream_test_while(void)
{
TEST_START();
TODO("Not implemented");
}
void stream_test_line_col(void)
{
TEST_START();
TODO("Not implemented");
}
MAKE_TEST_SUITE(STREAM_SUITE, "Stream Tests",
MAKE_TEST_FN(stream_test_prologue),
MAKE_TEST_FN(stream_test_string),
MAKE_TEST_FN(stream_test_file),
MAKE_TEST_FN(stream_test_peek_next),
MAKE_TEST_FN(stream_test_seek),
MAKE_TEST_FN(stream_test_substr),
MAKE_TEST_FN(stream_test_epilogue), );
/* 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/>.
*/

45
test/test_sv.c Normal file
View File

@@ -0,0 +1,45 @@
/* test_sv.c: String View tests
* Created: 2026-02-05
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include <assert.h>
#include <malloc.h>
#include "./data.h"
#include "./test.h"
void sv_copy_test(void)
{
TEST_START();
static_assert(ARRSIZE(unique_words) > 3, "Expected at least 3 unique words");
for (u64 i = 0; i < 3; ++i)
{
sv_t word = SV((char *)unique_words[i], strlen(unique_words[i]));
sv_t copy = sv_copy(word);
TEST(word.data != copy.data, "%p != %p", word.data, copy.data);
TEST(word.size == copy.size, "%lu == %lu", word.size, copy.size);
TEST(strncmp(word.data, copy.data, copy.size) == 0, "`%s` == `%s`",
word.data, copy.data);
// NOTE: Okay to free since we own copy.
free((void *)copy.data);
}
}
MAKE_TEST_SUITE(SV_SUITE, "String View Tests", MAKE_TEST_FN(sv_copy_test), );
/* 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/>.
*/

41
test/test_symtable.c Normal file
View File

@@ -0,0 +1,41 @@
/* test_symtable.c: Symbol table tests
* Created: 2026-02-05
* Author: Aryadev Chavali
* License: See end of file
* Commentary:
*/
#include "./data.h"
#include "./test.h"
void symtable_test(void)
{
TEST_START();
sym_table_t table = {0};
sym_table_init(&table);
for (u64 i = 0; i < ARRSIZE(words); ++i)
sym_table_find(&table, SV((char *)words[i], strlen(words[i])));
TEST(table.count == ARRSIZE(unique_words), "%lu == %lu", table.count,
ARRSIZE(unique_words));
sym_table_free(&table);
TEST_END();
}
MAKE_TEST_SUITE(SYMTABLE_SUITE, "Symbol Table Tests",
MAKE_TEST_FN(symtable_test), );
/* 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

@@ -8,8 +8,9 @@
#include "./data.h" #include "./data.h"
#include "./test.h" #include "./test.h"
void vec_test1(void) void vec_test_concat(void)
{ {
TEST_START();
sys_t system = {0}; sys_t system = {0};
sys_init(&system); sys_init(&system);
@@ -28,15 +29,17 @@ void vec_test1(void)
TEST(vec->size == ARRSIZE(words_text), "%lu == %lu", vec->size, TEST(vec->size == ARRSIZE(words_text), "%lu == %lu", vec->size,
ARRSIZE(words_text)); ARRSIZE(words_text));
TEST(strncmp((char *)vec_data(vec), words_text, vec->size) == 0, "%d", TEST(strncmp((char *)vec_data(vec), words_text, vec->size) == 0,
strncmp((char *)vec_data(vec), words_text, vec->size)); "%p@%lu == %p@%lu", (char *)vec_data(vec), vec->size, words_text,
strlen(words_text));
TEST_PASSED();
sys_free(&system); sys_free(&system);
TEST_END();
} }
void vec_test2(void) void vec_test_gen_substr(void)
{ {
TEST_START();
sys_t system = {0}; sys_t system = {0};
sys_init(&system); sys_init(&system);
// Generating substrings // Generating substrings
@@ -47,37 +50,31 @@ void vec_test2(void)
{0, 16}, {0, 16},
{0, 32}, {0, 32},
{32, 64}, {32, 64},
{0, ARRSIZE(text)}, {0, ARRSIZE(text) - 1},
}; };
for (u64 i = 0; i < ARRSIZE(tests); ++i) for (u64 i = 0; i < ARRSIZE(tests); ++i)
{ {
struct Test test = tests[i]; struct Test test = tests[i];
const sv_t substr = SV((char *)text + test.start, test.size); const sv_t substr = sv_substr(SV_AUTO(text), test.start, test.size);
const u64 size = test.size / 2; const u64 size = test.size / 2;
lisp_t *lvec = make_vec(&system, size); lisp_t *lvec = make_vec(&system, size);
vec_append(as_vec(lvec), text + test.start, test.size); vec_append(as_vec(lvec), text + test.start, test.size);
TEST(as_vec(lvec)->size > size, "%lu > %lu", as_vec(lvec)->size, size); TEST(as_vec(lvec)->size > size, "%lu > %lu", as_vec(lvec)->size, size);
TEST(strncmp((char *)vec_data(as_vec(lvec)), substr.data, substr.size) == 0, TEST(strncmp((char *)vec_data(as_vec(lvec)), substr.data, substr.size) == 0,
"%d", "%p@%lu == %p@%lu", (char *)vec_data(as_vec(lvec)), as_vec(lvec)->size,
strncmp((char *)vec_data(as_vec(lvec)), substr.data, substr.size)); substr.data, substr.size);
} }
TEST_PASSED();
sys_free(&system); sys_free(&system);
TEST_END();
} }
const test_fn TESTS_VEC[] = { MAKE_TEST_SUITE(VEC_SUITE, "Vector Tests",
MAKE_TEST_FN(vec_test1),
MAKE_TEST_FN(vec_test2),
};
const test_suite_t VEC_SUITE = { MAKE_TEST_FN(vec_test_concat),
.name = "Vector Tests", MAKE_TEST_FN(vec_test_gen_substr), );
.tests = TESTS_VEC,
.size = ARRSIZE(TESTS_VEC),
};
/* Copyright (C) 2026 Aryadev Chavali /* Copyright (C) 2026 Aryadev Chavali