Move some stuff around for cleanliness

runtime/constructor.c

@@ -0,0 +1,64 @@
+/* Copyright (C) 2025 Aryadev Chavali
+
+ * This program is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE.  See the Unlicense for details.
+
+ * You may distribute and modify this code under the terms of the Unlicense,
+ * which you should have received a copy of along with this program.  If not,
+ * please go to <https://unlicense.org/>.
+
+ * Created: 2025-08-20
+ * Description: Lisp constructors/destructors
+ */
+
+#include <malloc.h>
+
+#include "../alisp.h"
+
+lisp_t *make_int(i64 i)
+{
+  return tag_int(i);
+}
+
+lisp_t *cons(sys_t *sys, lisp_t *car, lisp_t *cdr)
+{
+  cons_t *cons = calloc(1, sizeof(*cons));
+  cons->car    = car;
+  cons->cdr    = cdr;
+
+  lisp_t *lcons = tag_cons(cons);
+  sys_register(sys, lcons);
+  return lcons;
+}
+
+lisp_t *make_vec(sys_t *sys, u64 capacity)
+{
+  vec_t *vec = calloc(1, sizeof(*vec));
+  vec_init(vec, capacity);
+  lisp_t *ptr = tag_vec(vec);
+  sys_register(sys, ptr);
+  return ptr;
+}
+
+lisp_t *intern(sys_t *sys, sv_t sv)
+{
+  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);
+}

runtime/stream.c

@@ -0,0 +1,369 @@
+/* Copyright (C) 2025 Aryadev Chavali
+
+ * This program is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE.  See the Unlicense for details.
+
+ * You may distribute and modify this code under the terms of the Unlicense,
+ * which you should have received a copy of along with this program.  If not,
+ * please go to <https://unlicense.org/>.
+
+ * Created: 2025-08-26
+ * Description: Stream implementation
+ */
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "../alisp.h"
+
+stream_err_t stream_init_string(stream_t *stream, char *name, sv_t contents)
+{
+  if (!stream)
+    return STREAM_ERR_INVALID_PTR;
+  name = name ? name : "<stream>";
+  memset(stream, 0, sizeof(*stream));
+
+  stream->type   = STREAM_TYPE_STRING;
+  stream->name   = name;
+  stream->string = sv_copy(contents);
+
+  return STREAM_ERR_OK;
+}
+
+stream_err_t stream_init_pipe(stream_t *stream, char *name, FILE *pipe)
+{
+  if (!stream || !pipe)
+    return STREAM_ERR_INVALID_PTR;
+  name = name ? name : "<stream>";
+  memset(stream, 0, sizeof(*stream));
+
+  stream->type      = STREAM_TYPE_PIPE;
+  stream->name      = name;
+  stream->pipe.file = pipe;
+
+  vec_init(&stream->pipe.cache, STREAM_DEFAULT_CHUNK);
+
+  return STREAM_ERR_OK;
+}
+
+stream_err_t stream_init_file(stream_t *stream, char *name, FILE *pipe)
+{
+  if (!stream || !pipe)
+    return STREAM_ERR_INVALID_PTR;
+  name = name ? name : "<stream>";
+  memset(stream, 0, sizeof(*stream));
+
+  stream->type      = STREAM_TYPE_FILE;
+  stream->name      = name;
+  stream->pipe.file = pipe;
+
+  vec_init(&stream->pipe.cache, STREAM_DEFAULT_CHUNK);
+
+  return STREAM_ERR_OK;
+}
+
+void stream_stop(stream_t *stream)
+{
+  if (!stream)
+    return;
+  switch (stream->type)
+  {
+  case STREAM_TYPE_STRING:
+    free(stream->string.data);
+    break;
+  case STREAM_TYPE_PIPE:
+  case STREAM_TYPE_FILE:
+    // Must cleanup vector
+    vec_free(&stream->pipe.cache);
+    break;
+  }
+  memset(stream, 0, sizeof(*stream));
+}
+
+u64 stream_size(stream_t *stream)
+{
+  assert(stream);
+  switch (stream->type)
+  {
+  case STREAM_TYPE_STRING:
+    return stream->string.size;
+  case STREAM_TYPE_PIPE:
+  case STREAM_TYPE_FILE:
+    return stream->pipe.cache.size;
+  default:
+    FAIL("Unreachable");
+    return 0;
+  }
+}
+
+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)
+{
+  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) &&
+           stream->position >= stream->pipe.cache.size;
+  default:
+    FAIL("Unreachable");
+    return 0;
+  }
+}
+
+bool stream_chunk(stream_t *stream)
+{
+  assert(stream);
+  u64 to_read = STREAM_DEFAULT_CHUNK;
+  switch (stream->type)
+  {
+  case STREAM_TYPE_STRING:
+    // vacuously true
+    return true;
+  case STREAM_TYPE_PIPE:
+    to_read = 1;
+    // fallthrough
+  case STREAM_TYPE_FILE:
+  {
+    if (feof(stream->pipe.file))
+      // We can't read anymore.  End of the line
+      return false;
+    vec_ensure_free(&stream->pipe.cache, to_read);
+    int read = fread(vec_data(&stream->pipe.cache) + stream->pipe.cache.size, 1,
+                     to_read, stream->pipe.file);
+
+    // If we read something it's a good thing
+    if (read > 0)
+    {
+      stream->pipe.cache.size += read;
+      return true;
+    }
+    else
+      return false;
+  }
+  default:
+    FAIL("Unreachable");
+    return 0;
+  }
+}
+
+char stream_next(stream_t *stream)
+{
+  char c = stream_peek(stream);
+  if (c != '\0')
+    ++stream->position;
+  return c;
+}
+
+char stream_peek(stream_t *stream)
+{
+  // If we've reached end of stream, and end of content, there's really nothing
+  // to check here.
+  if (stream_eoc(stream))
+    return '\0';
+
+  switch (stream->type)
+  {
+  case STREAM_TYPE_STRING:
+    return stream->string.data[stream->position];
+  case STREAM_TYPE_PIPE:
+  case STREAM_TYPE_FILE:
+  {
+    // Cached already?  We are done.
+    if (stream->position < stream->pipe.cache.size)
+    {
+      const char *const str = 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
+    // file.
+    for (bool read_chunk = stream_chunk(stream);
+         read_chunk && stream->position >= stream->pipe.cache.size;
+         read_chunk = stream_chunk(stream))
+      continue;
+
+    // Same principle as the stream_eos(stream) check.
+    if (stream->position >= stream->pipe.cache.size)
+      return '\0';
+    return ((char *)vec_data(&stream->pipe.cache))[stream->position];
+  }
+  default:
+    FAIL("Unreachable");
+    return 0;
+  }
+}
+
+bool stream_seek(stream_t *stream, i64 offset)
+{
+  if (offset < 0)
+    return stream_seek_backward(stream, offset * -1);
+  else if (offset > 0)
+    return stream_seek_forward(stream, offset);
+  else
+    // vacuously successful
+    return true;
+}
+
+bool stream_seek_forward(stream_t *stream, u64 offset)
+{
+  if (stream_eoc(stream))
+    return false;
+
+  switch (stream->type)
+  {
+  case STREAM_TYPE_STRING:
+  {
+    if (stream->position + offset >= stream->string.size)
+      return false;
+
+    stream->position += offset;
+    return true;
+  }
+  case STREAM_TYPE_PIPE:
+  case STREAM_TYPE_FILE:
+  {
+    // Similar principle as stream_peek really...
+
+    // 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
+    // file.
+    for (bool read_chunk = stream_chunk(stream);
+         read_chunk && stream->position + offset >= stream->pipe.cache.size;
+         read_chunk = stream_chunk(stream))
+      continue;
+
+    // Same principle as the stream_eoc(stream) check.
+    if (stream->position + offset > stream->pipe.cache.size)
+      return false;
+    stream->position += offset;
+    return true;
+  }
+  default:
+    FAIL("Unreachable");
+    return 0;
+  }
+}
+
+bool stream_seek_backward(stream_t *stream, u64 offset)
+{
+  assert(stream);
+  if (stream->position < offset)
+    return false;
+  stream->position -= offset;
+  return true;
+}
+
+sv_t stream_substr(stream_t *stream, u64 size)
+{
+  if (stream_eoc(stream))
+    return SV(NULL, 0);
+
+  // See if I can go forward enough to make this substring
+  u64 current_position = stream->position;
+  bool successful      = stream_seek_forward(stream, size);
+  // Reset the position in either situation
+  stream->position = current_position;
+
+  if (!successful)
+    return SV(NULL, 0);
+
+  char *ptr = NULL;
+  switch (stream->type)
+  {
+  case STREAM_TYPE_STRING:
+    ptr = stream->string.data;
+    break;
+  case STREAM_TYPE_PIPE:
+  case STREAM_TYPE_FILE:
+    ptr = 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)
+{
+  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_FILE:
+  {
+    if (index + size <= stream_size(stream))
+      return SV(vec_data(&stream->pipe.cache) + index, size);
+    // (index + size > stream_size(stream)) => try reading chunks
+    for (bool read_chunk = stream_chunk(stream);
+         read_chunk && index + size >= stream->pipe.cache.size;
+         read_chunk = stream_chunk(stream))
+      continue;
+
+    if (index + size > stream_size(stream))
+      return SV(NULL, 0);
+    return SV(vec_data(&stream->pipe.cache) + index, size);
+  }
+  default:
+    assert("Unreachable");
+    return SV(NULL, 0);
+  }
+}
+
+sv_t stream_till(stream_t *stream, const char *str)
+{
+  if (stream_eoc(stream))
+    return SV(NULL, 0);
+  u64 current_position = stream->position;
+  for (char c = stream_peek(stream); c != '\0' && strchr(str, c) == NULL;
+       c      = stream_next(stream))
+    continue;
+  u64 size = stream->position - current_position;
+  if (size == 0)
+    return SV(NULL, 0);
+  return stream_substr_abs(stream, current_position, size - 1);
+}
+
+sv_t stream_while(stream_t *stream, const char *str)
+{
+  if (stream_eoc(stream))
+    return SV(NULL, 0);
+  u64 current_position = stream->position;
+  for (char c = stream_peek(stream); c != '\0' && strchr(str, c);
+       c      = stream_next(stream))
+    continue;
+  u64 size = stream->position - current_position;
+  if (size == 0)
+    return SV(NULL, 0);
+  return stream_substr_abs(stream, current_position, size - 1);
+}

runtime/sv.c

@@ -0,0 +1,27 @@
+/* Copyright (C) 2025 Aryadev Chavali
+
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the Unlicense
+ * for details.
+
+ * You may distribute and modify this code under the terms of the
+ * Unlicense, which you should have received a copy of along with this
+ * program.  If not, please go to <https://unlicense.org/>.
+
+ * Created: 2025-08-21
+ * Description: String views
+ */
+
+#include <malloc.h>
+#include <string.h>
+
+#include "../alisp.h"
+
+sv_t sv_copy(sv_t old)
+{
+  char *newstr = calloc(1, (old.size + 1) * sizeof(*newstr));
+  memcpy(newstr, old.data, old.size);
+  newstr[old.size] = '\0';
+  return SV(newstr, old.size);
+}

runtime/symtable.c

@@ -0,0 +1,75 @@
+/* Copyright (C) 2025 Aryadev Chavali
+
+ * This program is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE.  See the Unlicense for details.
+
+ * You may distribute and modify this code under the terms of the Unlicense,
+ * which you should have received a copy of along with this program.  If not,
+ * please go to <https://unlicense.org/>.
+
+ * Created: 2025-08-19
+ * Description: Symbol Table implementation
+ */
+
+#include "../alisp.h"
+
+#include <malloc.h>
+#include <string.h>
+
+u64 djb2(sv_t string)
+{
+  u64 hash = 5381;
+  for (u64 i = 0; i < string.size; ++i)
+    hash = string.data[i] + (hash + (hash << 5));
+  return hash;
+}
+
+void sym_table_init(sym_table_t *table)
+{
+  table->capacity = MAX(table->capacity, SYM_TABLE_INIT_SIZE);
+  table->count    = 0;
+  vec_init(&table->entries, table->capacity * sizeof(sv_t));
+}
+
+char *sym_table_find(sym_table_t *table, sv_t sv)
+{
+  // Initialise the table if it's not done already
+  if (table->entries.capacity == 0)
+    sym_table_init(table);
+
+  // TODO: Deal with resizing this when table->count > table->size / 2
+  u64 index = djb2(sv) & (table->capacity - 1);
+
+  for (sv_t comp = VEC_GET(&table->entries, sv_t)[index]; comp.data; index += 1,
+            index = index & (table->capacity - 1),
+            comp  = VEC_GET(&table->entries, sv_t)[index])
+    // Is it present in the table?
+    if (sv.size == comp.size && strncmp(sv.data, comp.data, sv.size) == 0)
+      break;
+
+  // we couldn't find it in our linear search (worst case scenario)
+  if (!VEC_GET(&table->entries, sv_t)[index].data)
+  {
+    sv_t newsv                            = sv_copy(sv);
+    VEC_GET(&table->entries, sv_t)[index] = newsv;
+    ++table->count;
+  }
+
+  return VEC_GET(&table->entries, sv_t)[index].data;
+}
+
+void sym_table_cleanup(sym_table_t *table)
+{
+  // kill the data
+  sv_t current = {0};
+  for (u64 i = 0; i < table->capacity; ++i)
+  {
+    current = VEC_GET(&table->entries, sv_t)[i];
+    if (current.data)
+      free(current.data);
+  }
+  // kill the container
+  vec_free(&table->entries);
+  memset(table, 0, sizeof(*table));
+}

runtime/sys.c

@@ -0,0 +1,77 @@
+/* Copyright (C) 2025 Aryadev Chavali
+
+ * This program is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE.  See the Unlicense for details.
+
+ * You may distribute and modify this code under the terms of the Unlicense,
+ * which you should have received a copy of along with this program.  If not,
+ * please go to <https://unlicense.org/>.
+
+ * Created: 2025-08-20
+ * Description: System management
+ */
+
+#include "../alisp.h"
+
+#include <assert.h>
+#include <malloc.h>
+#include <string.h>
+
+void sys_init(sys_t *sys)
+{
+  memset(sys, 0, sizeof(*sys));
+}
+
+void sys_register(sys_t *sys, lisp_t *ptr)
+{
+  // Generate an unmanaged cons
+  cons_t *cons = calloc(1, sizeof(*cons));
+  cons->car    = ptr;
+  cons->cdr    = sys->conses;
+  sys->conses  = tag_cons(cons);
+}
+
+void sys_cleanup(sys_t *sys)
+{
+  static_assert(NUM_TAGS == 5);
+
+  sym_table_cleanup(&sys->symtable);
+
+  if (!sys->conses)
+    return;
+
+  // Iterate through each element of memory
+  for (lisp_t *cell = sys->conses, *next = cdr(cell); cell;
+       cell = next, next = cdr(next))
+  {
+    // Only reason allocated exists is because we had to allocate memory on the
+    // heap for it.  It's therefore enough to deal with only the allocated
+    // types.
+    lisp_t *allocated = car(cell);
+    switch (get_tag(allocated))
+    {
+    case TAG_CONS:
+      // Delete the cons
+      free(as_cons(allocated));
+      break;
+    case TAG_VEC:
+    {
+      vec_t *vec = as_vec(allocated);
+      vec_free(vec);
+      free(vec);
+      break;
+    }
+    case TAG_NIL:
+    case TAG_INT:
+    case TAG_SYM:
+    case NUM_TAGS:
+      // shouldn't be dealt with (either constant or dealt with elsewhere)
+      break;
+    }
+
+    // Then free the current cell
+    free(as_cons(cell));
+  }
+  memset(sys, 0, sizeof(*sys));
+}

runtime/tag.c

@@ -0,0 +1,76 @@
+/* Copyright (C) 2025 Aryadev Chavali
+
+ * This program is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE.  See the Unlicense for details.
+
+ * You may distribute and modify this code under the terms of the Unlicense,
+ * which you should have received a copy of along with this program.  If not,
+ * please go to <https://unlicense.org/>.
+
+ * Created: 2025-08-19
+ * Description: Pointer tagging
+ */
+
+#include <assert.h>
+#include <stdlib.h>
+
+#include "../alisp.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);
+}

runtime/vec.c

@@ -0,0 +1,94 @@
+/* Copyright (C) 2025 Aryadev Chavali
+
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the Unlicense
+ * for details.
+
+ * You may distribute and modify this code under the terms of the
+ * Unlicense, which you should have received a copy of along with this
+ * program.  If not, please go to <https://unlicense.org/>.
+
+ * Created: 2025-08-20
+ * Description: Stable Vector implementation
+ */
+
+#include <malloc.h>
+#include <string.h>
+
+#include "../alisp.h"
+
+void vec_init(vec_t *vec, u64 size)
+{
+  memset(vec, 0, sizeof(*vec));
+  if (!vec)
+    return;
+  else if (size <= VEC_INLINE_CAPACITY)
+  {
+    vec->is_inlined = 1;
+    vec->capacity   = VEC_INLINE_CAPACITY;
+    vec->ptr        = NULL;
+  }
+  else
+  {
+    vec->is_inlined = 0;
+    vec->capacity   = size;
+    vec->ptr        = calloc(1, vec->capacity);
+  }
+}
+
+void vec_free(vec_t *vec)
+{
+  if (!vec)
+    return;
+  if (!vec->is_inlined && vec->ptr)
+    free(vec->ptr);
+  memset(vec, 0, sizeof(*vec));
+}
+
+void *vec_data(vec_t *vec)
+{
+  return vec->is_inlined ? vec->inlined : vec->ptr;
+}
+
+void vec_ensure_free(vec_t *vec, u64 size)
+{
+  if (!vec)
+    return;
+  if (vec->capacity - vec->size < size)
+  {
+    vec->capacity = MAX(vec->capacity * VEC_MULT, vec->size + size);
+    if (vec->is_inlined)
+    {
+      // If we're inlined, we need to allocate on the heap now.  So let's copy
+      // vec->inlined over to vec->ptr, then turn off inlining.
+
+      // We need to do a two-way swap since vec->ptr and vec->inlined are taking
+      // up the same space.
+      u8 buffer[VEC_INLINE_CAPACITY];
+      memcpy(buffer, vec->inlined, vec->size);
+      vec->ptr = calloc(1, vec->capacity);
+      memcpy(vec->ptr, buffer, vec->size);
+      vec->is_inlined = 0;
+    }
+    else
+      vec->ptr = realloc(vec->ptr, vec->capacity);
+  }
+}
+
+void vec_append(vec_t *vec, const void *const ptr, u64 size)
+{
+  if (!vec)
+    return;
+  vec_ensure_free(vec, size);
+  memcpy(vec_data(vec) + vec->size, ptr, size);
+  vec->size += size;
+}
+
+void vec_clone(vec_t *dest, vec_t *src)
+{
+  if (!src || !dest)
+    return;
+  vec_init(dest, src->capacity);
+  memcpy(vec_data(dest), vec_data(src), src->size);
+}