diff --git a/src/argcountmacro.h b/src/argcountmacro.h index 6dd5b07..9a82704 100644 --- a/src/argcountmacro.h +++ b/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 diff --git a/src/base.c b/src/base.c index f279c46..fb3b866 100644 --- a/src/base.c +++ b/src/base.c @@ -3,6 +3,7 @@ #include "hashtable.h" #include "lisp.h" +#include #include 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; +} diff --git a/src/base.h b/src/base.h index 096ed06..79d0443 100644 --- a/src/base.h +++ b/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 +#include // ################### // # 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); diff --git a/src/function.c b/src/function.c index c58beab..99f6bc1 100644 --- a/src/function.c +++ b/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(); + } +} diff --git a/src/function.h b/src/function.h index 8439f34..0f67331 100644 --- a/src/function.h +++ b/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 diff --git a/src/main.c b/src/main.c index d74c24b..55b5b68 100644 --- a/src/main.c +++ b/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;