diff --git a/src/lisp.c b/src/lisp.c index 7fd3cf9..1cfc595 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -301,6 +301,7 @@ void set_function_args(LispFunction *func, LispVal *args) { refcount_unref(new_end); oargs_end = new_end; } + refcount_unref(desc); puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt); if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) { puthash(found_args, @@ -316,18 +317,22 @@ void set_function_args(LispFunction *func, LispVal *args) { refcount_unref(desc); goto malformed; } - USERPTR(struct OptArgDesc, desc)->index = 0; + USERPTR(struct OptArgDesc, desc)->index = + ((LispHashtable *) func->kwargs)->count; LispString *sn = ((LispSymbol *) USERPTR(struct OptArgDesc, desc)->name) ->name; char kns[sn->length + 2]; kns[0] = ':'; memcpy(kns + 1, sn->data, sn->length); - kns[sn->length + 1] = '\n'; + kns[sn->length + 1] = '\0'; LispVal *kn = make_lisp_string(kns, sn->length + 1, false, false); - puthash(func->kwargs, Fintern(kn), desc); + LispVal *keyword = Fintern(kn); + puthash(func->kwargs, keyword, desc); + refcount_unref(keyword); refcount_unref(kn); + refcount_unref(desc); puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt); if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) { puthash(found_args, @@ -910,6 +915,7 @@ static bool held_refs_callback(void *obj, RefcountList **held, void *ignored) { *held = refcount_list_push(*held, fn->rargs); *held = refcount_list_push(*held, fn->lexenv); *held = refcount_list_push(*held, fn->doc); + *held = refcount_list_push(*held, fn->rest_arg); if (!fn->is_builtin) { *held = refcount_list_push(*held, fn->body); } @@ -1003,117 +1009,85 @@ void lisp_init(void) { refcount_init_static(Qparent_lexenv); refcount_init_static(&_Qparent_lexenv_name); - { - refcount_init_static(Qbreakpoint); - refcount_init_static(((LispSymbol *) Qbreakpoint)->name); - puthash(Vobarray, ((LispVal *) (((LispSymbol *) Qbreakpoint)->name)), - Qbreakpoint); - }; - { - refcount_init_static(((LispSymbol *) Qbreakpoint)->function); - ((LispFunction *) (((LispSymbol *) Qbreakpoint)->function))->doc = - (make_lisp_string(("Do nothing..."), sizeof("") - 1, 1, 1)); - LispVal *src = - (make_lisp_string(("(&opt id)"), sizeof("(&opt id)") - 1, 1, 1)); - LispVal *a = Fread(src); - set_function_args( - (LispFunction *) (((LispSymbol *) Qbreakpoint)->function), a); - refcount_unref(src); - refcount_unref(a); - }; - ; - /* REGISTER_FUNCTION(sethead, "(pair newval)", */ - /* "Set the head of PAIR to NEWVAL."); */ - /* REGISTER_FUNCTION(settail, "(pair newval)", */ - /* "Set the tail of PAIR to NEWVAL."); */ - /* REGISTER_FUNCTION(funcall, "(function &rest args)", "") */ - /* REGISTER_FUNCTION(apply, "(function &rest args)", "") */ - /* REGISTER_FUNCTION(throw, "(signal &rest data)", ""); */ - /* REGISTER_FUNCTION(pair, "(head tail)", */ - /* "Return a new pair with HEAD and TAIL."); */ - /* REGISTER_FUNCTION(head, "(pair)", "Return the head of PAIR."); */ - /* REGISTER_FUNCTION(tail, "(pair)", "Return the tail of PAIR."); */ - /* REGISTER_FUNCTION(quote, "(form)", "Return FORM as read by the reader."); - */ - /* REGISTER_FUNCTION(exit, "(&opt code)", */ - /* "Exit with CODE, defaulting to zero."); */ - /* REGISTER_FUNCTION(print, "(obj)", */ - /* "Print a human-readable representation of OBJ."); */ - /* REGISTER_FUNCTION( */ - /* println, "(obj)", */ - /* "Print a human-readable representation of OBJ followed by a - * newline."); */ - /* REGISTER_FUNCTION(not, "(obj)", */ - /* "Return t if OBJ is nil, otherwise return t."); */ - /* REGISTER_FUNCTION(add, "(&rest nums)", "Return the sun of NUMS."); */ - /* REGISTER_FUNCTION(sub, "(&rest nums)", */ - /* "Return (head NUMS) - (apply '+ (tail NUMS))."); */ - /* REGISTER_FUNCTION( */ - /* if, "(cond then &rest else)", */ - /* "Evaluate THEN if COND is non-nil, otherwise evaluate ELSE."); */ - /* REGISTER_FUNCTION( */ - /* setq, "(&rest name-value-pairs)", */ - /* "Set each of a number of variables to their respective values."); */ - /* REGISTER_FUNCTION(progn, "(&rest forms)", "Evaluate each of FORMS."); */ - /* REGISTER_FUNCTION(symbol_function, "(sym &opt resolve)", ""); */ - /* REGISTER_FUNCTION(fset, "(sym new-func)", ""); */ - /* REGISTER_FUNCTION(defun, "(name args &rest body)", */ - /* "Define NAME to be a new function."); */ - /* REGISTER_FUNCTION(defmacro, "(name args &rest body)", */ - /* "Define NAME to be a new macro."); */ - /* REGISTER_FUNCTION(lambda, "(args &rest body)", "Return a new closure."); - */ - /* REGISTER_FUNCTION(while, "(cond &rest body)", */ - /* "Run BODY until COND returns nil."); */ - /* REGISTER_FUNCTION(eval, "(expr)", "Evaluate the lisp expression EXPR"); - */ - /* REGISTER_FUNCTION(read, "(source)", */ - /* "Read and return the next s-expr from SOURCE."); */ - /* REGISTER_FUNCTION(eq, "(obj1 obj2)", */ - /* "Return non-nil if OBJ1 and OBJ2 are equal"); */ - /* REGISTER_FUNCTION(make_symbol, "(name)", */ - /* "Return a new un-interned symbol named NAME."); */ - /* REGISTER_FUNCTION(macroexpand_1, "(form)", */ - /* "Return the form which FORM expands to."); */ - /* REGISTER_FUNCTION(stringp, "(val)", "Return non-nil if VAL is a - * string."); */ - /* REGISTER_FUNCTION(symbolp, "(val)", "Return non-nil if VAL is a - * symbol."); */ - /* REGISTER_FUNCTION(pairp, "(val)", "Return non-nil if VAL is a pair."); */ - /* REGISTER_FUNCTION(integerp, "(val)", "Return non-nil if VAL is a - * integer."); */ - /* REGISTER_FUNCTION(floatp, "(val)", "Return non-nil if VAL is a float."); - */ - /* REGISTER_FUNCTION(vectorp, "(val)", "Return non-nil if VAL is a - * vector."); */ - /* REGISTER_FUNCTION(functionp, "(val)", */ - /* "Return non-nil if VAL is a function."); */ - /* REGISTER_FUNCTION(macrop, "(val)", "Return non-nil if VAL is a macro."); - */ - /* REGISTER_FUNCTION(hashtablep, "(val)", */ - /* "Return non-nil if VAL is a hashtable."); */ - /* REGISTER_FUNCTION(user_pointer_p, "(val)", */ - /* "Return non-nil if VAL is a user pointer."); */ - /* REGISTER_FUNCTION(atom, "(val)", "Return non-nil if VAL is a atom."); */ - /* REGISTER_FUNCTION(listp, "(val)", "Return non-nil if VAL is a list."); */ - /* REGISTER_FUNCTION(keywordp, "(val)", "Return non-nil if VAL is a - * keyword."); */ - /* REGISTER_FUNCTION(numberp, "(val)", "Return non-nil if VAL is a - * number."); */ - /* REGISTER_FUNCTION(list_length, "(list)", "Return the length of LIST."); - */ - /* REGISTER_FUNCTION(num_eq, "(n1 n2)", */ - /* "Return non-nil if N1 and N2 are equal numerically.") - */ - /* REGISTER_FUNCTION(num_gt, "(n1 n2)", */ - /* "Return non-nil if N1 is greather than N2.") */ - /* REGISTER_FUNCTION(and, "(&rest args)", */ - /* "Logical and (with short circuit evaluation.)"); */ - /* REGISTER_FUNCTION(or, "(&rest args)", */ - /* "Logical or (with short circuit evaluation.)"); */ - /* REGISTER_FUNCTION(type_of, "(obj)", "Return the type of OBJ."); */ - /* REGISTER_FUNCTION(function_docstr, "(func)", */ - /* "Return the documentation string of FUNC.") */ + REGISTER_FUNCTION(breakpoint, "(&opt id)", "Do nothing..."); + REGISTER_FUNCTION(sethead, "(pair newval)", + "Set the head of PAIR to NEWVAL."); + REGISTER_FUNCTION(settail, "(pair newval)", + "Set the tail of PAIR to NEWVAL."); + REGISTER_FUNCTION(funcall, "(function &rest args)", "") + REGISTER_FUNCTION(apply, "(function &rest args)", "") + REGISTER_FUNCTION(throw, "(signal &rest data)", ""); + REGISTER_FUNCTION(pair, "(head tail)", + "Return a new pair with HEAD and TAIL."); + REGISTER_FUNCTION(head, "(pair)", "Return the head of PAIR."); + REGISTER_FUNCTION(tail, "(pair)", "Return the tail of PAIR."); + REGISTER_FUNCTION(quote, "(form)", "Return FORM as read by the reader."); + REGISTER_FUNCTION(exit, "(&opt code)", + "Exit with CODE, defaulting to zero."); + REGISTER_FUNCTION(print, "(obj)", + "Print a human-readable representation of OBJ."); + REGISTER_FUNCTION( + println, "(obj)", + "Print a human-readable representation of OBJ followed by a newline."); + REGISTER_FUNCTION(not, "(obj)", + "Return t if OBJ is nil, otherwise return t."); + REGISTER_FUNCTION(add, "(&rest nums)", "Return the sun of NUMS."); + REGISTER_FUNCTION(sub, "(&rest nums)", + "Return (head NUMS) - (apply '+ (tail NUMS))."); + REGISTER_FUNCTION( + if, "(cond then &rest else)", + "Evaluate THEN if COND is non-nil, otherwise evaluate ELSE."); + REGISTER_FUNCTION( + setq, "(&rest name-value-pairs)", + "Set each of a number of variables to their respective values."); + REGISTER_FUNCTION(progn, "(&rest forms)", "Evaluate each of FORMS."); + REGISTER_FUNCTION(symbol_function, "(sym &opt resolve)", ""); + REGISTER_FUNCTION(fset, "(sym new-func)", ""); + REGISTER_FUNCTION(defun, "(name args &rest body)", + "Define NAME to be a new function."); + REGISTER_FUNCTION(defmacro, "(name args &rest body)", + "Define NAME to be a new macro."); + REGISTER_FUNCTION(lambda, "(args &rest body)", "Return a new closure."); + REGISTER_FUNCTION(while, "(cond &rest body)", + "Run BODY until COND returns nil."); + REGISTER_FUNCTION(eval, "(expr)", "Evaluate the lisp expression EXPR"); + REGISTER_FUNCTION(read, "(source)", + "Read and return the next s-expr from SOURCE."); + REGISTER_FUNCTION(eq, "(obj1 obj2)", + "Return non-nil if OBJ1 and OBJ2 are equal"); + REGISTER_FUNCTION(make_symbol, "(name)", + "Return a new un-interned symbol named NAME."); + REGISTER_FUNCTION(macroexpand_1, "(form)", + "Return the form which FORM expands to."); + REGISTER_FUNCTION(stringp, "(val)", "Return non-nil if VAL is a string."); + REGISTER_FUNCTION(symbolp, "(val)", "Return non-nil if VAL is a symbol."); + REGISTER_FUNCTION(pairp, "(val)", "Return non-nil if VAL is a pair."); + REGISTER_FUNCTION(integerp, "(val)", "Return non-nil if VAL is a integer."); + REGISTER_FUNCTION(floatp, "(val)", "Return non-nil if VAL is a float."); + REGISTER_FUNCTION(vectorp, "(val)", "Return non-nil if VAL is a vector."); + REGISTER_FUNCTION(functionp, "(val)", + "Return non-nil if VAL is a function."); + REGISTER_FUNCTION(macrop, "(val)", "Return non-nil if VAL is a macro."); + REGISTER_FUNCTION(hashtablep, "(val)", + "Return non-nil if VAL is a hashtable."); + REGISTER_FUNCTION(user_pointer_p, "(val)", + "Return non-nil if VAL is a user pointer."); + REGISTER_FUNCTION(atom, "(val)", "Return non-nil if VAL is a atom."); + REGISTER_FUNCTION(listp, "(val)", "Return non-nil if VAL is a list."); + REGISTER_FUNCTION(keywordp, "(val)", "Return non-nil if VAL is a keyword."); + REGISTER_FUNCTION(numberp, "(val)", "Return non-nil if VAL is a number."); + REGISTER_FUNCTION(list_length, "(list)", "Return the length of LIST."); + REGISTER_FUNCTION(num_eq, "(n1 n2)", + "Return non-nil if N1 and N2 are equal numerically.") + REGISTER_FUNCTION(num_gt, "(n1 n2)", + "Return non-nil if N1 is greather than N2.") + REGISTER_FUNCTION(and, "(&rest args)", + "Logical and (with short circuit evaluation.)"); + REGISTER_FUNCTION(or, "(&rest args)", + "Logical or (with short circuit evaluation.)"); + REGISTER_FUNCTION(type_of, "(obj)", "Return the type of OBJ."); + REGISTER_FUNCTION(function_docstr, "(func)", + "Return the documentation string of FUNC.") } void lisp_shutdown(void) { diff --git a/src/main.c b/src/main.c index 554921c..4b6ce97 100644 --- a/src/main.c +++ b/src/main.c @@ -67,56 +67,60 @@ LispVal *Ftoplevel_error_handler(LispVal *except) { DEF_STATIC_SYMBOL(toplevel_read, "toplevel-read"); int main(int argc, const char **argv) { - /* if (argc < 2) { */ - /* fprintf(stderr, "No input file!\n"); */ - /* return 1; */ - /* } */ - /* FILE *in = fopen(argv[1], "r"); */ - /* if (!in) { */ - /* perror("fopen"); */ - /* return 1; */ - /* } */ - /* fseek(in, 0, SEEK_END); */ - /* off_t file_len = ftello(in); */ - /* rewind(in); */ - /* char buffer[file_len]; */ - /* fread(buffer, 1, file_len, in); */ - /* fclose(in); */ + if (argc < 2) { + fprintf(stderr, "No input file!\n"); + return 1; + } + FILE *in = fopen(argv[1], "r"); + if (!in) { + perror("fopen"); + return 1; + } + fseek(in, 0, SEEK_END); + off_t file_len = ftello(in); + rewind(in); + char buffer[file_len]; + fread(buffer, 1, file_len, in); + fclose(in); lisp_init(); - /* refcount_init_static(Qtoplevel_read); */ - /* REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", ""); */ - /* REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", ""); */ - /* size_t pos = 0; */ - /* WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { */ - /* the_stack->hidden = true; */ - /* LispVal *err_var = INTERN_STATIC("err-var"); */ - /* puthash( */ - /* the_stack->handlers, Qt, */ - /* // simply call the above function */ - /* const_list(3, err_var, Ftoplevel_error_handler_function, - * err_var)); */ - /* puthash( */ - /* the_stack->handlers, Qshutdown_signal, */ - /* // simply call the above function */ - /* const_list(3, err_var, Ftoplevel_exit_handler_function, - * err_var)); */ - /* LispVal *nil_nil = Fpair(Qnil, Qnil); */ - /* puthash(the_stack->handlers, Qeof_error, */ - /* // ignore */ - /* nil_nil); */ - /* refcount_unref(nil_nil); */ - /* refcount_unref(err_var); */ - /* while (pos < file_len) { */ - /* LispVal *tv; */ - /* WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, { */ - /* pos += read_from_buffer(buffer + pos, file_len - pos, &tv); - */ - /* }); */ - /* WITH_CLEANUP(tv, { */ - /* refcount_unref(Feval(tv)); // */ - /* }); */ - /* } */ - /* }); */ + REGISTER_SYMBOL(toplevel_read); + REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", ""); + REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", ""); + size_t pos = 0; + WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { + the_stack->hidden = true; + /* LispVal *err_var = INTERN_STATIC("err-var"); */ + /* puthash( */ + /* the_stack->handlers, Qt, */ + /* // simply call the above function */ + /* const_list(3, err_var, Ftoplevel_error_handler_function, + * err_var)); */ + /* puthash( */ + /* the_stack->handlers, Qshutdown_signal, */ + /* // simply call the above function */ + /* const_list(3, err_var, Ftoplevel_exit_handler_function, + * err_var)); */ + /* LispVal *nil_nil = Fpair(Qnil, Qnil); */ + /* puthash(the_stack->handlers, Qeof_error, */ + /* // ignore */ + /* nil_nil); */ + /* refcount_unref(nil_nil); */ + /* refcount_unref(err_var); */ + while (true) { + LispVal *tv; + WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, { + size_t res = + read_from_buffer(buffer + pos, file_len - pos, &tv); + if (res == LISP_EOF) { + break; + } + pos += res; + }); + WITH_CLEANUP(tv, { + refcount_unref(Feval(tv)); // + }); + } + }); lisp_shutdown(); return exit_status; } diff --git a/src/read.c b/src/read.c index 0dbe876..df85dab 100644 --- a/src/read.c +++ b/src/read.c @@ -40,8 +40,9 @@ static int peekc(struct ReadState *state) { return *state->head; } -static inline void _internal_read_error(struct ReadState *state, size_t len, - LispVal *desc, LispVal *cause) { +static inline _Noreturn void _internal_read_error(struct ReadState *state, + size_t len, LispVal *desc, + LispVal *cause) { if (len > state->left) { len = state->left; } @@ -96,6 +97,7 @@ static LispVal *read_list(struct ReadState *state) { } LispVal *elt = read_internal(state); if (is_dot_symbol(elt)) { + refcount_unref(elt); if (NILP(list)) { READ_ERROR(state, 1, "Dot cannot start a list"); } @@ -116,9 +118,11 @@ static LispVal *read_list(struct ReadState *state) { break; } else if (NILP(list)) { list = Fpair(elt, Qnil); + refcount_unref(elt); end = list; } else { LispVal *new_end = Fpair(elt, Qnil); + refcount_unref(elt); Fsettail(end, new_end); refcount_unref(new_end); end = new_end; @@ -214,7 +218,8 @@ static LispVal *read_character(struct ReadState *state) { {"null", 4, '\0'}, {"\\0", 2, '\0'}, {"newline", 7, '\n'}, {"\\n", 2, '\n'}, {"tab", 3, '\t'}, {"\\t", 2, '\t'}, }; -#define LOOKUP_TABLE_SIZE (sizeof(LOOKUP_TABLE) / sizeof(LOOKUP_TABLE[0])) + static const size_t LOOKUP_TABLE_SIZE = + sizeof(LOOKUP_TABLE) / sizeof(LOOKUP_TABLE[0]); struct ReadState start_state = *state; popc(state); // # const char *start = state->head; @@ -231,7 +236,6 @@ static LispVal *read_character(struct ReadState *state) { READ_ERROR(&start_state, len, "unknown character liternal: %*s", (int) len, start); return Qnil; -#undef LOOKUP_TABLE_SIZE } #define INVALID_BASE -2 @@ -473,8 +477,8 @@ size_t read_from_buffer(const char *text, size_t length, LispVal **out) { }; LispVal *res = read_internal(&state); if (!res) { - EOF_ERROR(&state); *out = Qnil; + return LISP_EOF; } else { *out = res; } @@ -482,12 +486,19 @@ size_t read_from_buffer(const char *text, size_t length, LispVal **out) { } DEFUN(read, "read", (LispVal * source)) { - if (STRINGP(source)) { - LispString *str = (LispString *) source; - LispVal *v; - read_from_buffer(str->data, str->length, &v); - return v; + LispString *str = (LispString *) source; + struct ReadState state = { + .head = str->data, + .left = str->length, + .off = 0, + .line = 1, + .col = 0, + .backquote_level = 0, + }; + LispVal *res = read_internal(&state); + if (!res) { + EOF_ERROR(&state); } else { - Fthrow(Qtype_error, Qnil); + return res; } } diff --git a/src/read.h b/src/read.h index 5e83ee2..f9db116 100644 --- a/src/read.h +++ b/src/read.h @@ -3,8 +3,11 @@ #include "lisp.h" +#include #include +#define LISP_EOF SIZE_MAX + size_t read_from_buffer(const char *text, size_t length, LispVal **out); DECLARE_FUNCTION(read, (LispVal * source));