Type errors

src/argcountmacro.h

@@ -9,6 +9,8 @@
 // return the arg count - 1, allowing for a dummy value to be passed
 #define COUNT_ARGS_SAFE(...) \
     internal_TENTH(__VA_ARGS__, 8, 7, 6, 5, 4, 3, 2, 1, 0, 0)
+#define MAX_COUNTED_ARGS      9
+#define MAX_COUNTED_SAFE_ARGS 8
 
 #define MACRO_EVAL(a)     a
 #define MACRO_GLUE(a, b)  a##b

src/base.c

@@ -3,6 +3,7 @@
 #include "hashtable.h"
 #include "lisp.h"
 
+#include <stdio.h>
 #include <string.h>
 
 const char *LISP_TYPE_NAMES[N_LISP_TYPES] = {
@@ -27,6 +28,18 @@ void *lisp_alloc_object(size_t size, LispValType type) {
     return obj;
 }
 
+void signal_type_error(LispVal *obj, size_t count,
+                       const LispValType types[count]) {
+    // TODO actually throw an error
+    fprintf(stderr, "Type error! Got: %s | Expected: (or ",
+            LISP_TYPE_NAMES[TYPE_OF(obj)]);
+    for (size_t i = 0; i < count; ++i) {
+        fprintf(stderr, "%s%s", LISP_TYPE_NAMES[i],
+                i < count - 1 ? " " : ")\n");
+    }
+    abort();
+}
+
 DEFINE_SYMBOL(nil, "nil");
 DEFINE_SYMBOL(t, "t");
 DEFINE_SYMBOL(unbound, "unbound");
@@ -71,7 +84,7 @@ DEFUN(make_symbol, "make-symbol", (LispVal * name), "(name)",
 }
 
 DEFUN(intern, "intern", (LispVal * name), "(name)", "") {
-    // TODO type checking
+    CHECK_TYPE(name, TYPE_STRING);
     LispVal *res = Fgethash(obarray, name, Qunbound);
     if (res != Qunbound) {
         return res;
@@ -80,3 +93,15 @@ DEFUN(intern, "intern", (LispVal * name), "(name)", "") {
     Fputhash(obarray, name, newsym);
     return newsym;
 }
+
+DEFUN(symbol_function, "symbol-function", (LispVal * sym, LispVal *resolve),
+      "(sym &optional resolve)", "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    if (NILP(resolve)) {
+        return ((LispSymbol *) sym)->function;
+    }
+    while (!NILP(sym) && SYMBOLP(sym)) {
+        sym = ((LispSymbol *) sym)->function;
+    }
+    return sym;
+}

src/base.h

@@ -1,10 +1,12 @@
 #ifndef INCLUDED_TYPES_H
 #define INCLUDED_TYPES_H
 
+#include "argcountmacro.h"
 #include "gc.h"
 #include "memory.h"
 
 #include <assert.h>
+#include <stdnoreturn.h>
 
 // ###################
 // # Base value type #
@@ -119,6 +121,29 @@ static ALWAYS_INLINE bool LISP_TYPEP(LispVal *val, LispValType type) {
     }
 }
 
+noreturn void signal_type_error(LispVal *obj, size_t count,
+                                const LispValType types[count]);
+static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count,
+                                              LispValType v1, LispValType v2,
+                                              LispValType v3, LispValType v4,
+                                              LispValType v5, LispValType v6) {
+    const LispValType types[] = {v1, v2, v3, v4, v5, v6};
+    for (size_t i = 0; i < count; ++i) {
+        if (LISP_TYPEP(obj, types[i])) {
+            return;
+        }
+    }
+    // Failed
+    signal_type_error(obj, count, types);
+}
+#define internal_CHECK_TYPE1(obj, type) internal_CHECK_TYPE(obj, v1, )
+#define internal_CHECK_TYPE_SUB(obj, count, a1, a2, a3, a4, a5, a6, ...) \
+    internal_CHECK_TYPE((obj), count, a1, a2, a3, a4, a5, a6)
+#define CHECK_TYPE(obj, ...)                                             \
+    internal_CHECK_TYPE_SUB((obj), COUNT_ARGS(__VA_ARGS__), __VA_ARGS__, \
+                            TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM,       \
+                            TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM)
+
 #define DEFOBJTYPE(Name, NAME, NAME_P, body)         \
     typedef struct {                                 \
         LispObject header;                           \
@@ -186,6 +211,7 @@ DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
 LispVal *make_vector(LispVal **data, size_t length, bool take);
 DECLARE_FUNCTION(make_symbol, (LispVal * name));
 DECLARE_FUNCTION(intern, (LispVal * name));
+DECLARE_FUNCTION(symbol_function, (LispVal * sym, LispVal *resolve));
 
 // TODO these are actually special-forms
 DECLARE_SYMBOL(quote);

src/function.c

@@ -157,7 +157,8 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(),
                                LispVal *docstr) {
     LispFunction *obj = lisp_alloc_object(sizeof(LispFunction), TYPE_FUNCTION);
     obj->name = name;
-    obj->is_native = true;
+    obj->flags.type = FUNCTION_NATIVE;
+    obj->flags.no_eval_args = false;
     obj->docstr = docstr;
     obj->impl.native.zero = cfunc;
     ReadStream stream;
@@ -182,3 +183,31 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(),
     }
     return obj;
 }
+
+// Calling functions
+static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
+                                          LispFunction *fobj, LispVal *args) {
+    return Qnil;
+}
+
+DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
+      "") {
+    CHECK_TYPE(func, TYPE_FUNCTION, TYPE_SYMBOL);
+    LispFunction *fobj = func;
+    if (SYMBOLP(func)) {
+        fobj = Fsymbol_function(func, Qt);
+    }
+    if (!FUNCTIONP(fobj)) {
+        // TODO error
+        abort();
+    }
+    switch (fobj->flags.type) {
+    case FUNCTION_NATIVE:
+        return call_native(func, fobj, args);
+    case FUNCTION_INTERP:
+    case FUNCTION_BYTECOMP:
+    default:
+        // TODO implement
+        abort();
+    }
+}

src/function.h

@@ -29,9 +29,20 @@ union native_function {
     LispVal *(*five)(LispVal *, LispVal *, LispVal *, LispVal *, LispVal *);
 };
 
+typedef enum {
+    FUNCTION_NATIVE,
+    FUNCTION_INTERP,
+    FUNCTION_BYTECOMP,
+} LispFunctionType;
+
+struct function_flags {
+    LispFunctionType type : 2;
+    unsigned int no_eval_args : 1;
+};
+
 DEFOBJTYPE(Function, FUNCTION, FUNCTIONP, {
     LispVal *name; // symbol (or nil for a lambda)
-    bool is_native;
+    struct function_flags flags;
     struct LambdaList args;
     LispVal *docstr;
     union {
@@ -71,4 +82,6 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*func)(),
         make_lisp_string(internal_F##cname##_docstr,                       \
                          internal_F##cname##_docstr_len, false, false))
 
+DECLARE_FUNCTION(funcall, (LispVal * func, LispVal *args));
+
 #endif

src/main.c

@@ -9,6 +9,7 @@ int main(int argc, const char **argv) {
     const char BUF[] = "t";
     read_stream_init(&s, BUF, sizeof(BUF) - 1);
     LispVal *l = read(&s);
+    CHECK_TYPE(l, TYPE_FIXNUM);
     printf("%d\n", l == Qt);
     lisp_shutdown();
     return 0;