Global generation

Makefile

@@ -3,17 +3,32 @@ CFLAGS=-g -std=c11 -Wall -Wpedantic
 LD=gcc
 LDFLAGS=-g
 
-SRCS=$(wildcard src/*.c)
+SRCS:=$(wildcard src/*.c)
-OBJS=$(SRCS:src/%.c=bin/%.o)
+OBJS:=$(SRCS:src/%.c=bin/%.o)
-DEPS=$(SRCS:src/%.c=bin/deps/%.d)
+DEPS:=$(SRCS:src/%.c=bin/deps/%.d)
+
+SRCS += bin/init_globals.c
+OBJS += bin/init_globals.o
+DEPS += bin/deps/init_globals.o
+
+HEADERS=$(wildcard src/*.h)
+SRCS_WITH_HEADERS=$(filter $(HEADERS:src/%.h=src/%.c),$(SRCS))
 
 glisp: $(OBJS)
 	$(LD) $(LDFLAGS) -o $@ $^
 
+bin/init_globals.c: $(filter-out bin/init_globals.c,$(SRCS_WITH_HEADERS)) src/gen-init-globals.awk
+	@mkdir -p bin/
+	awk -f src/gen-init-globals.awk $(filter-out src/gen-init-globals.awk,$^) >$@
+
 bin/%.o: src/%.c
 	@mkdir -p bin/deps
 	$(CC) $(CFLAGS) -c -MMD -MF $(<:src/%.c=bin/deps/%.d) -o $@ $<
 
+bin/init_globals.o: bin/init_globals.c
+	@mkdir -p bin/deps
+	$(CC) $(CFLAGS) -Isrc/ -c -MMD -MF bin/deps/init_globals.d -o $@ $<
+
 clean:
 	rm -rf glisp bin/
 

src/base.c

@@ -1,5 +1,8 @@
 #include "base.h"
 
+#include "hashtable.h"
+#include "lisp.h"
+
 #include <string.h>
 
 const char *LISP_TYPE_NAMES[N_LISP_TYPES] = {
@@ -16,11 +19,11 @@ const char *LISP_TYPE_NAMES[N_LISP_TYPES] = {
 void *lisp_alloc_object(size_t size, LispValType type) {
     assert(size >= sizeof(LispObject));
     LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size);
+    obj->type = type;
     obj->gc.immortal = false;
     obj->gc.mark = false;
     // TODO set the below
     obj->gc.entry = NULL;
-    obj->type = type;
     return obj;
 }
 
@@ -28,24 +31,23 @@ DEFINE_SYMBOL(nil, "nil");
 DEFINE_SYMBOL(t, "t");
 DEFINE_SYMBOL(unbound, "unbound");
 
+DEFINE_SYMBOL(quote, "quote");
+DEFINE_SYMBOL(backquote, "`");
+DEFINE_SYMBOL(comma, ",");
+DEFINE_SYMBOL(comma_at, ",@");
+
+DEFUN(id, "id", (LispVal * obj), "(id)", "") {
+    // TODO not all values are handled here
+    return MAKE_FIXNUM((uintptr_t) obj);
+}
+
+DEFUN(eq, "eq", (LispVal * obj1, LispVal *obj2), "(obj1 obj2)", "") {
+    return obj1 == obj2 ? Qt : Qnil;
+}
+
 // ################
 // # Constructors #
 // ################
-LispVal *make_lisp_string(const char *data, size_t length, bool take,
-                          bool copy) {
-    LispString *obj = lisp_alloc_object(sizeof(LispString), TYPE_STRING);
-    obj->owned = take;
-    obj->length = length;
-    if (copy) {
-        obj->data = lisp_malloc(length + 1);
-        memcpy(obj->data, data, length);
-        obj->data[length] = '\0';
-    } else {
-        obj->data = (char *) data;
-    }
-    return obj;
-}
-
 LispVal *make_vector(LispVal **data, size_t length, bool take) {
     LispVector *obj = lisp_alloc_object(sizeof(LispVector), TYPE_VECTOR);
     obj->length = length;
@@ -63,12 +65,18 @@ DEFUN(make_symbol, "make-symbol", (LispVal * name), "(name)",
     LispSymbol *obj = lisp_alloc_object(sizeof(LispSymbol), TYPE_SYMBOL);
     obj->name = name;
     obj->function = Qnil;
-    obj->value = Qnil;
+    obj->value = Qunbound;
     obj->plist = Qnil;
     return obj;
 }
 
 DEFUN(intern, "intern", (LispVal * name), "(name)", "") {
-    // TODO implement
+    // TODO type checking
-    return Fmake_symbol(name);
+    LispVal *res = Fgethash(obarray, name, Qunbound);
+    if (res != Qunbound) {
+        return res;
+    }
+    LispVal *newsym = Fmake_symbol(name);
+    Fputhash(obarray, name, newsym);
+    return newsym;
 }

src/base.h

@@ -95,6 +95,10 @@ typedef struct {
     ObjectGCInfo gc;
 } LispObject;
 
+static ALWAYS_INLINE void MAKE_OBJ_IMMORTAL(LispVal *obj) {
+    ((LispObject *) obj)->gc.immortal = true;
+}
+
 static ALWAYS_INLINE LispValType TYPE_OF(LispVal *val) {
     if (FIXNUMP(val)) {
         return TYPE_FIXNUM;
@@ -125,12 +129,6 @@ static ALWAYS_INLINE bool LISP_TYPEP(LispVal *val, LispValType type) {
     }                                                \
     struct __ignored
 
-DEFOBJTYPE(String, STRING, STRINGP, {
-    size_t length;
-    char *data;
-    bool owned;
-});
-
 DEFOBJTYPE(Symbol, SYMBOL, SYMBOLP, {
     LispVal *name; // string
     LispVal *function;
@@ -143,21 +141,32 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
     LispVal **data;
 });
 
+// Defined here instead of in function.h so that headers don't have to include
+// it just to define functions
 #define DECLARE_SYMBOL(cname)                         \
-    extern const char *Q##cname##_name; \
+    extern const char *internal_Q##cname##_name;      \
+    extern const size_t internal_Q##cname##_name_len; \
     extern LispVal *Q##cname
 
 #define DECLARE_FUNCTION(cname, cargs)                  \
     DECLARE_SYMBOL(cname);                              \
-    extern const char F##cname_name;   \
+    extern const char *internal_F##cname##_argstr;      \
+    extern const size_t internal_F##cname##_argstr_len; \
+    extern const char *internal_F##cname##_docstr;      \
+    extern const size_t internal_F##cname##_docstr_len; \
     LispVal *F##cname cargs
 
 #define DEFINE_SYMBOL(cname, lisp_name)                                \
-    const char *Q##cname##_name = lisp_name; \
+    const char *internal_Q##cname##_name = lisp_name;                  \
+    const size_t internal_Q##cname##_name_len = sizeof(lisp_name) - 1; \
     LispVal *Q##cname
 
 #define DEFUN(cname, lisp_name, cargs, lisp_args, doc)                   \
     DEFINE_SYMBOL(cname, lisp_name);                                     \
+    const char *internal_F##cname##_argstr = lisp_args;                  \
+    const size_t internal_F##cname##_argstr_len = sizeof(lisp_args) - 1; \
+    const char *internal_F##cname##_docstr = doc;                        \
+    const size_t internal_F##cname##_docstr_len = sizeof(doc) - 1;       \
     LispVal *Q##cname;                                                   \
     LispVal *F##cname cargs
 
@@ -169,13 +178,19 @@ static ALWAYS_INLINE bool NILP(LispVal *val) {
     return val == Qnil;
 }
 
+// Some core functions
+DECLARE_FUNCTION(id, (LispVal * obj));
+DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
+
 // TODO probably move these to another file
-LispVal *make_lisp_string(const char *data, size_t length, bool take,
-                          bool copy);
 LispVal *make_vector(LispVal **data, size_t length, bool take);
-#define LISP_LITSTR(litstr) \
-    (make_lisp_string(litstr, sizeof(litstr) - 1, false, false))
 DECLARE_FUNCTION(make_symbol, (LispVal * name));
 DECLARE_FUNCTION(intern, (LispVal * name));
 
+// TODO these are actually special-forms
+DECLARE_SYMBOL(quote);
+DECLARE_SYMBOL(backquote);
+DECLARE_SYMBOL(comma);
+DECLARE_SYMBOL(comma_at);
+
 #endif

src/function.c

@@ -1 +1,184 @@
 #include "function.h"
+
+#include "lisp.h"
+#include "list.h"
+#include "read.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+
+const char *llps_strerror(LambdaListParseStatus status) {
+    static const char *MSGS[LLPS_N_ERROS] = {
+        [LLPS_OK] = "No error",
+        [LLPS_DOTTED] = "Dotted list",
+        [LLPS_REPEAT_SECTION] = "Repeated section",
+        [LLPS_REPEAT_NAME] = "Repeated name",
+        [LLPS_SYNTAX] = "Syntax error",
+        [LLPS_BAD_NAME] = "Invalid variable name",
+    };
+    return MSGS[status];
+}
+
+DEFINE_SYMBOL(and_optional, "&optional");
+DEFINE_SYMBOL(and_rest, "&rest");
+DEFINE_SYMBOL(and_key, "&key");
+DEFINE_SYMBOL(and_allow_other_keys, "&allow-other-keys");
+
+static bool is_valid_variable_name(LispVal *val) {
+    return SYMBOLP(val) && !NILP(val) && val != Qt && val != Qunbound;
+}
+
+// on error, put the object that caused the problem in entry
+static LambdaListParseStatus parse_optional_arg_spec(LispVal **out,
+                                                     LispVal *entry) {
+    // single symbol
+    if (SYMBOLP(entry)) {
+        if (!is_valid_variable_name(entry)) {
+            *out = entry;
+            return LLPS_BAD_NAME;
+        }
+        *out = LIST(entry, Qnil, Qnil);
+        return LLPS_OK;
+    } else if (!CONSP(entry)) {
+        *out = entry;
+        return LLPS_BAD_NAME;
+    }
+    // list
+    LispVal *name = XCAR(entry);
+    if (!is_valid_variable_name(name)) {
+        *out = name;
+        return LLPS_BAD_NAME;
+    }
+    if (list_length_eq(entry, 1)) {
+        *out = LIST(XCAR(entry), Qnil, Qnil);
+        return LLPS_OK;
+    } else if (list_length_eq(entry, 2)) {
+        *out = LIST(name, XCAR(XCDR(entry)), Qnil);
+        return LLPS_OK;
+    } else if (list_length_eq(entry, 3)) {
+        LispVal *pvar = XCAR(XCDR(XCDR(entry)));
+        if (!is_valid_variable_name(pvar)) {
+            return LLPS_BAD_NAME;
+        }
+        *out = LIST(XCAR(entry), XCAR(XCDR(entry)), pvar);
+        return LLPS_OK;
+    } else {
+        *out = entry;
+        return LLPS_SYNTAX;
+    }
+}
+
+#define RETURN_ERROR(err, obj)   \
+    {                            \
+        result->status = err;    \
+        result->err_obj = (obj); \
+        return;                  \
+    }
+void parse_lambda_list(LambdaListParseResult *result, LispVal *list) {
+    enum { REQ = 0, OPT = 1, KEY = 2, REST, MUST_CHANGE } mode = REQ;
+    unsigned int seen = 0;
+    result->err_obj = Qnil;
+    result->status = LLPS_OK;
+    struct LambdaList *out = &result->lambda_list;
+    // TODO check for repeat names
+    out->n_req = 0;
+    out->n_opt = 0;
+    out->n_kw = 0;
+    out->allow_other_keys = false;
+    out->req = Qnil;
+    out->opt = Qnil;
+    out->kw = Qnil;
+    out->rest = Qnil;
+    FOREACH_TAIL(list, tail) {
+        if (!LISTP(tail)) {
+            RETURN_ERROR(LLPS_DOTTED, list);
+        }
+        LispVal *cur = XCAR(tail);
+        if (cur == Qand_allow_other_keys) {
+            if (out->allow_other_keys) {
+                RETURN_ERROR(LLPS_REPEAT_SECTION, list);
+            }
+            out->allow_other_keys = true;
+            mode = MUST_CHANGE;
+        } else if (cur == Qand_rest) {
+            if (!NILP(out->rest) || mode == REST) {
+                RETURN_ERROR(LLPS_REPEAT_SECTION, list)
+            }
+            mode = REST;
+        } else if (cur == Qand_optional) {
+            if (seen & OPT) {
+                RETURN_ERROR(LLPS_REPEAT_SECTION, list)
+            }
+            seen |= OPT;
+            mode = OPT;
+        } else if (cur == Qand_key) {
+            if (seen & KEY) {
+                RETURN_ERROR(LLPS_REPEAT_SECTION, list)
+            }
+            seen |= KEY;
+            mode = KEY;
+        } else if (mode == MUST_CHANGE) {
+            // &rest without a variable
+            RETURN_ERROR(LLPS_SYNTAX, list)
+        } else if (mode == REST) {
+            if (!is_valid_variable_name(cur)) {
+                RETURN_ERROR(LLPS_BAD_NAME, cur)
+            }
+            out->rest = cur;
+            mode = MUST_CHANGE;
+        } else if (mode == OPT || mode == KEY) {
+            LispVal *entry;
+            LambdaListParseStatus status = parse_optional_arg_spec(&entry, cur);
+            if (status != LLPS_OK) {
+                RETURN_ERROR(status, entry)
+            }
+            if (mode == OPT) {
+                out->opt = CONS(entry, out->opt);
+                ++out->n_opt;
+            } else {
+                out->kw = CONS(entry, out->kw);
+                ++out->n_kw;
+            }
+        } else if (!is_valid_variable_name(cur)) {
+            RETURN_ERROR(LLPS_BAD_NAME, cur);
+        } else {
+            out->req = CONS(cur, out->req);
+            ++out->n_req;
+        }
+    }
+    out->req = Fnreverse(out->req);
+    out->opt = Fnreverse(out->opt);
+    out->kw = Fnreverse(out->kw);
+}
+#undef RETURN_ERROR
+
+LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(),
+                               const char *lisp_args, size_t args_len,
+                               LispVal *docstr) {
+    LispFunction *obj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION);
+    obj->name = name;
+    obj->is_native = true;
+    obj->docstr = docstr;
+    obj->impl.native.zero = cfunc;
+    ReadStream stream;
+    read_stream_init(&stream, lisp_args, args_len);
+    LispVal *args_form = read(&stream);
+    if (!args_form) {
+        fprintf(stderr, "Builtin function lambda list had a syntax error\n");
+        fprintf(stderr, "Name: ");
+        debug_print(stderr, name);
+        fprintf(stderr, "\nLambda list: \"%s\"\n", lisp_args);
+        exit(1);
+    }
+    LambdaListParseResult result;
+    parse_lambda_list(&result, args_form);
+    if (result.status != LLPS_OK) {
+        fprintf(stderr, "Error parsing builtin lambda list: %s\n",
+                llps_strerror(result.status));
+        fprintf(stderr, "Name: ");
+        debug_print(stderr, name);
+        fprintf(stderr, "\nLambda list: \"%s\"\n", lisp_args);
+        exit(1);
+    }
+    return obj;
+}

src/function.h

@@ -2,15 +2,22 @@
 #define INCLUDED_FUNCTION_H
 
 #include "base.h"
+#include "lisp_string.h"
+
+DECLARE_SYMBOL(and_optional);
+DECLARE_SYMBOL(and_rest);
+DECLARE_SYMBOL(and_key);
+DECLARE_SYMBOL(and_allow_other_keys);
 
 struct LambdaList {
     size_t n_req;
     size_t n_opt;
     size_t n_kw;
+    bool allow_other_keys;
     LispVal *req; // list of symbols
     LispVal *opt; // list of lists of (name default has-p-name)
     LispVal *kw; // ditto opt
-    LispVal *rest; // symbom (non-nil if we have a rest arg)
+    LispVal *rest; // symbol (non-nil if we have a rest arg)
 };
 
 union native_function {
@@ -23,11 +30,45 @@ union native_function {
 };
 
 DEFOBJTYPE(Function, FUNCTION, FUNCTIONP, {
+    LispVal *name; // symbol (or nil for a lambda)
     bool is_native;
     struct LambdaList args;
+    LispVal *docstr;
     union {
         union native_function native;
     } impl;
 });
 
+typedef enum {
+    LLPS_OK,
+    LLPS_DOTTED,
+    LLPS_REPEAT_SECTION,
+    LLPS_REPEAT_NAME,
+    LLPS_SYNTAX,
+    LLPS_BAD_NAME,
+    LLPS_N_ERROS,
+} LambdaListParseStatus;
+
+const char *llps_strerror(LambdaListParseStatus status);
+
+typedef struct {
+    struct LambdaList lambda_list;
+    LambdaListParseStatus status;
+    LispVal *err_obj; // the object the caused the above status
+} LambdaListParseResult;
+
+void parse_lambda_list(LambdaListParseResult *out, LispVal *list);
+
+// This will cause the program to exit if an error occurs while parsing
+// LISP_ARGS!
+LispVal *make_builtin_function(LispVal *name, LispVal *(*func)(),
+                               const char *lisp_args, size_t args_len,
+                               LispVal *docstr);
+#define BUILTIN_FUNCTION_OBJ(cname)                                        \
+    make_builtin_function(                                                 \
+        Q##cname, (LispVal * (*) ()) F##cname, internal_F##cname##_argstr, \
+        internal_F##cname##_argstr_len,                                    \
+        make_lisp_string(internal_F##cname##_docstr,                       \
+                         internal_F##cname##_docstr_len, false, false))
+
 #endif

src/gen-init-globals.awk

@@ -0,0 +1,86 @@
+# This script is designed to be run from the root of the project
+BEGIN {
+    # Special symbols registered manually
+    special_syms["t"] = 1
+    special_syms["nil"] = 1
+    special_syms["unbound"] = 1
+    special_syms["hash_string"] = 1
+    special_syms["strings_equal"] = 1
+
+    FS = "[,(]"
+
+    print "// This file was automatically generated by src/gen-init-globals.awk"
+    print "// DO NOT MODIFY THIS FILE MANUALLY!"
+    print ""
+    print "#include \"init_globals.h\""
+    print ""
+
+    for (i = 1; i < ARGC; i += 1) {
+        name = ARGV[i]
+        sub(/\.c$/, ".h", name)
+        sub(/^(.+\/)?src\//, "", name)
+        print "#include \"" name "\""
+    }
+
+    print ""
+    print "void register_globals() {"
+    first_header = 1
+}
+
+function maybe_print_file_header() {
+    if (!seen_files[FILENAME]) {
+        if (!first_header) {
+            print ""
+        }
+        first_header = 0
+        seen_files[FILENAME] = 1
+        name = FILENAME
+        sub(/^(.+\/)?src\//, "", name)
+        print "    // " name
+    }
+}
+
+function get_next_symbol() {
+    out = ""
+    if (!$2) {
+        while (1) {
+            old_rs = RS
+            RS = FS
+            getline line
+            RS = old_rs
+            if (line ~ /\s/) {
+                out = line
+                break
+            }
+        }
+    } else {
+        out = $2
+    }
+    if (out && !special_syms[out]) {
+        gsub(/\s/, "", out)
+        return out
+    } else {
+        return ""
+    }
+}
+
+function maybe_emit_next_symbol(entity) {
+    name = get_next_symbol()
+    if (name) {
+        print "    REGISTER_GLOBAL_" entity "(" get_next_symbol() ");";
+    }
+}
+
+/DEFUN\(/ {
+    maybe_print_file_header()
+    maybe_emit_next_symbol("FUNCTION")
+}
+
+/DEFINE_SYMBOL\(/ {
+    maybe_print_file_header()
+    maybe_emit_next_symbol("SYMBOL")
+}
+
+END {
+    print "}"
+}

src/hashtable.c

@@ -1,5 +1,7 @@
 #include "hashtable.h"
 
+#include "lisp_string.h"
+
 #define INITIAL_SIZE     32
 #define GROWTH_THRESHOLD 0.5
 #define GROWTH_FACTOR    2
@@ -25,16 +27,20 @@ DEFUN(make_hash_table, "make-hash-table", (LispVal * hash_fn, LispVal *eq_fn),
 }
 
 static uintptr_t hash_key_for_table(LispHashTable *ht, LispVal *key) {
-    if (NILP(ht->hash_fn)) {
+    if (NILP(ht->hash_fn) || ht->hash_fn == Qid) {
         return (uintptr_t) key;
+    } else if (ht->hash_fn == Qhash_string) { // needed for initialization
+        return XFIXNUM(Fhash_string(key));
     }
     // TODO change
     abort();
 }
 
 static bool compare_keys(LispHashTable *ht, LispVal *key1, LispVal *key2) {
-    if (NILP(ht->eq_fn)) {
+    if (NILP(ht->eq_fn) || ht->eq_fn == Qeq) {
         return key1 == key2;
+    } else if (ht->eq_fn == Qstrings_equal) { // needed for initialization
+        return !NILP(Fstrings_equal(key1, key2));
     }
     // TODO change
     abort();
@@ -70,7 +76,7 @@ static void rehash(LispHashTable *ht, size_t new_size) {
 }
 
 static void maybe_rehash(LispHashTable *ht) {
-    if (TABLE_LOAD(ht) > GROWTH_THRESHOLD) {
+    if (TABLE_LOAD(ht) >= GROWTH_THRESHOLD) {
         rehash(ht, ht->size * GROWTH_FACTOR);
     }
 }

src/init_globals.h

@@ -0,0 +1,23 @@
+#ifndef INCLUDED_INIT_GLOBALS_H
+#define INCLUDED_INIT_GLOBALS_H
+
+#include "base.h"
+
+// defined in a generated file
+void register_globals(void);
+
+#include <stdio.h>
+
+#define REGISTER_GLOBAL_SYMBOL(cname)                                     \
+    {                                                                     \
+        Q##cname = Fintern(make_lisp_string(internal_Q##cname##_name,     \
+                                            internal_Q##cname##_name_len, \
+                                            false, false));               \
+    }
+#define REGISTER_GLOBAL_FUNCTION(cname)                                    \
+    {                                                                      \
+        REGISTER_GLOBAL_SYMBOL(cname);                                     \
+        ((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \
+    }
+
+#endif

src/lisp.c

@@ -1,9 +1,53 @@
 #include "lisp.h"
 
-void lisp_init() {
+#include "hashtable.h"
+#include "init_globals.h"
+#include "lisp_string.h"
+
+LispVal *obarray;
+
+static void construct_manual_symbols() {
+    // IMPORTANT: the symbols listed here need to also be set as special in
+    // gen-init-globals.awk
     Qnil = Fmake_symbol(LISP_LITSTR("nil"));
+    MAKE_OBJ_IMMORTAL(Qnil);
+    ((LispSymbol *) Qnil)->function = Qnil;
+    ((LispSymbol *) Qnil)->plist = Qnil;
     Qt = Fmake_symbol(LISP_LITSTR("t"));
+    MAKE_OBJ_IMMORTAL(Qt);
+    ((LispSymbol *) Qt)->value = Qt;
     Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
+    MAKE_OBJ_IMMORTAL(Qunbound);
+    ((LispSymbol *) Qunbound)->value = Qunbound;
+    ((LispSymbol *) Qnil)->value = Qunbound;
+
+    Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
+    MAKE_OBJ_IMMORTAL(Qhash_string);
+    Qstrings_equal = Fmake_symbol(LISP_LITSTR("strings-equal"));
+    MAKE_OBJ_IMMORTAL(Qstrings_equal);
+}
+
+static void register_manual_symbols() {
+#define INTERN(cname) \
+    Fputhash(obarray, ((LispSymbol *) Q##cname)->name, Q##cname);
+    INTERN(nil);
+    INTERN(t);
+    INTERN(unbound);
+    INTERN(hash_string);
+    INTERN(strings_equal);
+#undef INTERN
+}
+
+void lisp_init() {
+    construct_manual_symbols();
+    obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
+    // these call Fintern, so they need to have obarray constructed
+    ((LispSymbol *) Qhash_string)->function = BUILTIN_FUNCTION_OBJ(hash_string);
+    ((LispSymbol *) Qstrings_equal)->function =
+        BUILTIN_FUNCTION_OBJ(hash_string);
+
+    register_manual_symbols();
+    register_globals();
 }
 
 void lisp_shutdown() {}

src/lisp.h

@@ -4,10 +4,13 @@
 #include "base.h"
 #include "function.h"
 #include "hashtable.h"
+#include "lisp_string.h"
 #include "list.h"
 
 #include <stdio.h>
 
+extern LispVal *obarray;
+
 void lisp_init(void);
 
 void lisp_shutdown(void);

src/lisp_string.c

@@ -0,0 +1,43 @@
+#include "lisp_string.h"
+
+#include <string.h>
+
+LispVal *make_lisp_string(const char *data, size_t length, bool take,
+                          bool copy) {
+    LispString *obj = lisp_alloc_object(sizeof(LispString), TYPE_STRING);
+    obj->owned = take;
+    obj->length = length;
+    if (copy) {
+        obj->data = lisp_malloc(length + 1);
+        memcpy(obj->data, data, length);
+        obj->data[length] = '\0';
+    } else {
+        obj->data = (char *) data;
+    }
+    return obj;
+}
+
+DEFUN(strings_equal, "strings-equal", (LispVal * string1, LispVal *string2),
+      "(string1 string2)", "") {
+    // TODO type checking
+    if (((LispString *) string1)->length != ((LispString *) string2)->length) {
+        return Qnil;
+    }
+    return memcmp(((LispString *) string1)->data,
+                  ((LispString *) string2)->data,
+                  ((LispString *) string1)->length)
+                   == 0
+               ? Qt
+               : Qnil;
+}
+
+DEFUN(hash_string, "hash-string", (LispVal * string), "(string)", "") {
+    // TODO type checking
+    size_t len = ((LispString *) string)->length;
+    const char *str = ((LispString *) string)->data;
+    uintptr_t hash = 5381;
+    for (size_t i = 0; i < len; ++i) {
+        hash = ((hash << 5) + hash) + str[i];
+    }
+    return MAKE_FIXNUM(hash);
+}

src/lisp_string.h

@@ -0,0 +1,20 @@
+#ifndef INCLUDED_LISP_STRING_H
+#define INCLUDED_LISP_STRING_H
+
+#include "base.h"
+
+DEFOBJTYPE(String, STRING, STRINGP, {
+    size_t length;
+    char *data;
+    bool owned;
+});
+
+LispVal *make_lisp_string(const char *data, size_t length, bool take,
+                          bool copy);
+#define LISP_LITSTR(litstr) \
+    (make_lisp_string(litstr, sizeof(litstr) - 1, false, false))
+
+DECLARE_FUNCTION(strings_equal, (LispVal * string1, LispVal *string2));
+DECLARE_FUNCTION(hash_string, (LispVal * string));
+
+#endif

src/list.c

@@ -16,6 +16,14 @@ intptr_t list_length(LispVal *list) {
     return length;
 }
 
+bool list_length_eq(LispVal *list, intptr_t size) {
+    assert(LISTP(list));
+    while (size-- && CONSP(list)) {
+        list = XCDR(list);
+    }
+    return size == 0;
+}
+
 DEFUN(cons, "cons", (LispVal * car, LispVal *cdr), "(car cdr)",
       "Construct a new cons object from CAR and CDR.") {
     return CONS(car, cdr);
@@ -25,3 +33,21 @@ DEFUN(length, "length", (LispVal * list), "(list)", "") {
     // TODO type check
     return MAKE_FIXNUM(list_length(list));
 }
+
+DEFUN(length_eq, "length=", (LispVal * list, LispVal *length), "(list length)",
+      "Return non-nil if LIST's length is LENGTH.") {
+    // TODO type check
+    return list_length_eq(list, XFIXNUM(length)) ? Qt : Qnil;
+}
+
+DEFUN(nreverse, "nreverse", (LispVal * list), "(list)", "") {
+    // TODO type checking
+    LispVal *rev = Qnil;
+    while (!NILP(list)) {
+        LispVal *next = XCDR(list);
+        RPLACD(list, rev);
+        rev = list;
+        list = next;
+    }
+    return rev;
+}

src/list.h

@@ -98,8 +98,12 @@ static ALWAYS_INLINE LispVal *LIST_N(int count, ...) {
 #define FOREACH_TAIL(l, v) for (LispVal *v = (l); !NILP(v); v = XCDR_SAFE(v))
 
 intptr_t list_length(LispVal *list);
+// Return true if the length of LIST == SIZE
+bool list_length_eq(LispVal *list, intptr_t size);
 
 DECLARE_FUNCTION(cons, (LispVal * car, LispVal *cdr));
 DECLARE_FUNCTION(length, (LispVal * list));
+DECLARE_FUNCTION(length_eq, (LispVal * list, LispVal *length));
+DECLARE_FUNCTION(nreverse, (LispVal * list));
 
 #endif

src/main.c

@@ -6,14 +6,10 @@
 int main(int argc, const char **argv) {
     lisp_init();
     ReadStream s;
-    const char BUF[] = "`(1 . ,2)";
+    const char BUF[] = "t";
     read_stream_init(&s, BUF, sizeof(BUF) - 1);
     LispVal *l = read(&s);
-    if (!l) {
+    printf("%d\n", l == Qt);
-        printf("EOF\n");
-    } else {
-        debug_obj_info(stdout, l);
-    }
     lisp_shutdown();
     return 0;
 }

src/read.c

@@ -1,5 +1,6 @@
 #include "read.h"
 
+#include "lisp_string.h"
 #include "list.h"
 
 #include <ctype.h>
@@ -406,7 +407,7 @@ LispVal *read(ReadStream *stream) {
         if (EOSP(stream)) {
             read_error(stream, 0, "quote not quoting anything");
         }
-        return LIST(Fintern(LISP_LITSTR("quote")), read(stream));
+        return LIST(Qquote, read(stream));
     }
     case '`': {
         ++stream->backquote_level;
@@ -415,7 +416,7 @@ LispVal *read(ReadStream *stream) {
         if (EOSP(stream)) {
             read_error(stream, 0, "backquote not quoting anything");
         }
-        LispVal *to_return = LIST(Fintern(LISP_LITSTR("`")), read(stream));
+        LispVal *to_return = LIST(Qbackquote, read(stream));
         --stream->backquote_level;
         return to_return;
     }
@@ -426,9 +427,9 @@ LispVal *read(ReadStream *stream) {
         pop_char(stream);
         LispVal *car;
         if (peek_char(stream) == '@') {
-            car = Fintern(LISP_LITSTR(","));
+            car = Qcomma_at;
         } else {
-            car = Fintern(LISP_LITSTR(",@"));
+            car = Qcomma;
         }
         skip_whitespace(stream);
         if (EOSP(stream)) {