Zander671/simple-lisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix some parsing bugs and allow running files

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-07-01 01:31:44 +09:00
parent 40f717277d
commit e557e58168
4 changed files with 142 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
src/lisp.c
View File

@ -589,7 +589,7 @@ DEFUN(backtrace, "backtrace", ()) {
DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) {
CHECK_TYPE(TYPE_SYMBOL, signal);
LispVal *backtrace = Fbacktrace();
LispVal *error_arg = make_list(2, Fpair(signal, rest), Fbacktrace());
for (; the_stack; stack_leave()) {
if (!the_stack->enable_handlers) {
continue;
@ -608,10 +608,9 @@ DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) {
the_stack->hidden = true;
if (!NILP(var)) {
// TODO make sure this isn't constant
Fputhash(the_stack->lexenv, var,
make_list(2, Fpair(signal, rest), backtrace));
Fputhash(the_stack->lexenv, var, error_arg);
}
WITH_CLEANUP(backtrace, {
WITH_CLEANUP(error_arg, {
IGNORE_REF(Feval(form)); //
});
});
@ -619,7 +618,7 @@ DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) {
}
}
// we never used it, so drop it
lisp_unref(backtrace);
lisp_unref(error_arg);
fprintf(stderr,
"ERROR: An exception has propogated past the top of the stack!\n");
fprintf(stderr, "Type: ");
@ -633,6 +632,7 @@ DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) {
DEF_STATIC_SYMBOL(shutdown_signal, "shutdown-signal");
DEF_STATIC_SYMBOL(type_error, "type-error");
DEF_STATIC_SYMBOL(read_error, "read-error");
DEF_STATIC_SYMBOL(eof_error, "eof-error");
DEF_STATIC_SYMBOL(void_variable_error, "void-variable-error");
DEF_STATIC_SYMBOL(void_function_error, "void-function-error");
DEF_STATIC_SYMBOL(circular_error, "circular-error");
@ -654,6 +654,13 @@ void lisp_init() {
REGISTER_SYMBOL(tail);
REGISTER_SYMBOL(quote);
REGISTER_SYMBOL(exit);
REGISTER_SYMBOL(print);
REGISTER_SYMBOL(println);
REGISTER_SYMBOL(not);
REGISTER_SYMBOL(when);
REGISTER_SYMBOL(add);
REGISTER_SYMBOL(if);
REGISTER_SYMBOL(setq);
#undef REGISTER_SYMBOL
}
@ -883,6 +890,65 @@ DEFMACRO(quote, "'", (LispVal * form)) {
return form;
}
DEFUN(print, "print", (LispVal * obj)) {
debug_dump(stdout, obj, false);
return Qnil;
}
DEFUN(println, "println", (LispVal * obj)) {
debug_dump(stdout, obj, true);
return Qnil;
}
DEFUN(not, "not", (LispVal * obj)) {
return NILP(obj) ? Qt : Qnil;
}
DEFMACRO(if, "if", (LispVal * cond, LispVal *t, LispVal *nil)) {
LispVal *res = Feval(cond);
LispVal *retval = Qnil;
WITH_PUSH_FRAME(Qnil, Qnil, true, {
the_stack->hidden = true;
if (!NILP(res)) {
retval = Feval(t);
} else {
retval = Feval(nil);
}
});
return retval;
}
DEFMACRO(when, "when", (LispVal * cond, LispVal *t)) {
return Fif(cond, t, Qnil);
}
DEFUN(add, "+", (LispVal * n1, LispVal *n2)) {
if (INTEGERP(n1) && INTEGERP(n2)) {
return make_lisp_integer(((LispInteger *) n1)->value
+ ((LispInteger *) n2)->value);
} else if (INTEGERP(n1) && FLOATP(n2)) {
return make_lisp_float(((LispInteger *) n1)->value
+ ((LispFloat *) n2)->value);
} else if (FLOATP(n1) && INTEGERP(n2)) {
return make_lisp_float(((LispFloat *) n1)->value
+ ((LispInteger *) n2)->value);
} else if (FLOATP(n1) && FLOATP(n2)) {
return make_lisp_float(((LispFloat *) n1)->value
+ ((LispFloat *) n2)->value);
} else {
Fthrow(Qtype_error, Qnil);
}
}
DEFMACRO(setq, "setq", (LispVal * name, LispVal *value)) {
CHECK_TYPE(TYPE_SYMBOL, name);
LispSymbol *sym = (LispSymbol *) name;
LispVal *evaled = Feval(value);
lisp_unref(sym->value);
sym->value = lisp_ref(evaled);
return evaled;
}
static void debug_dump_real(FILE *stream, void *obj, bool first) {
switch (TYPEOF(obj)) {
case TYPE_STRING: {

8
src/lisp.h
View File

@ -379,6 +379,7 @@ noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
extern LispVal *Qshutdown_signal;
extern LispVal *Qtype_error;
extern LispVal *Qread_error;
extern LispVal *Qeof_error;
extern LispVal *Qvoid_variable_error;
extern LispVal *Qvoid_function_error;
extern LispVal *Qcircular_error;
@ -404,6 +405,13 @@ DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(head, (LispVal * list));
DECLARE_FUNCTION(tail, (LispVal * list));
noreturn DECLARE_FUNCTION(exit, (LispVal * code));
DECLARE_FUNCTION(print, (LispVal * obj));
DECLARE_FUNCTION(println, (LispVal * obj));
DECLARE_FUNCTION(not, (LispVal * obj));
DECLARE_FUNCTION(when, (LispVal * cond, LispVal *t));
DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil));
DECLARE_FUNCTION(add, (LispVal * n1, LispVal *n2));
DECLARE_FUNCTION(setq, (LispVal * name, LispVal *value));
void debug_dump(FILE *stream, void *obj, bool newline);
void debug_print_hashtable(FILE *stream, LispVal *table);

41
src/main.c
View File

@ -56,12 +56,26 @@ LispVal *Ftoplevel_error_handler(LispVal *except) {
return Qnil;
}
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);
lisp_init();
char buffer[] = "(t)";
LispVal *tv;
read_from_buffer(buffer, sizeof(buffer) - 1, &tv);
lisp_ref(tv);
size_t pos = 0;
WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
the_stack->hidden = true;
LispVal *err_var = INTERN_STATIC("err-var");
@ -73,12 +87,19 @@ int main(int argc, const char **argv) {
the_stack->handlers, Qshutdown_signal,
// simply call the above function
make_list(3, err_var, Ftoplevel_exit_handler_function, err_var));
LispVal *out = Feval(tv);
lisp_ref(out);
debug_dump(stdout, out, 1);
lisp_unref(out);
})
UNREF_INPLACE(tv);
Fputhash(the_stack->handlers, Qeof_error,
// ignore
Fpair(Qnil, Qnil));
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, {
IGNORE_REF(Feval(tv)); //
})
}
});
lisp_shutdown();
return exit_status;
}

53
src/read.c
View File

@ -26,7 +26,7 @@ static int popc(struct ReadState *state) {
int c = *(state->head++);
if (c == '\n') {
++state->line;
state->off = 0;
state->col = 0;
} else {
++state->col;
}
@ -41,24 +41,28 @@ static int peekc(struct ReadState *state) {
}
static inline void _internal_read_error(struct ReadState *state, size_t len,
LispVal *desc) {
// TODO format better
LispVal *desc, LispVal *cause) {
if (len > state->left) {
len = state->left;
}
LispVal *args = make_list(
4, make_lisp_integer(state->line), make_lisp_integer(state->col),
make_lisp_string(state->head, len, false, false), desc);
lisp_ref(args);
Fthrow(Qread_error, args);
UNREF_INPLACE(args);
WITH_CLEANUP(args, {
Fthrow(cause, args); //
});
}
#define READ_ERROR(state, len, ...) \
_internal_read_error(state, len, sprintf_lisp(__VA_ARGS__))
#define EOF_ERROR(state) READ_ERROR(state, 1, "unexpected end of file")
_internal_read_error(state, len, sprintf_lisp(__VA_ARGS__), Qread_error)
#define EOF_ERROR(state) \
_internal_read_error(state, 1, sprintf_lisp("unexpected end of file"), \
Qeof_error)
#define SKIP_WHILE(cond, state) \
while (cond) { \
popc(state); \
}
#define SKIP_WHITESPACE(state) SKIP_WHILE(isblank(peekc(state)), state)
#define SKIP_WHITESPACE(state) SKIP_WHILE(isspace(peekc(state)), state)
static bool is_symbol_end(int c) {
return c == EOS || isspace(c) || c == '(' || c == ')' || c == '['
@ -123,47 +127,46 @@ static LispVal *read_string(struct ReadState *state) {
bool backslash = false;
int c;
char *str = lisp_malloc(1);
str[0] = '\0';
size_t str_len = 0;
while (backslash || (c = peekc(state)) != '"') {
while (backslash || peekc(state) != '"') {
if (c == EOS) {
lisp_free(str);
EOF_ERROR(state);
return Qnil;
}
popc(state);
c = popc(state);
if (!backslash && c == '\\') {
backslash = true;
} else if (backslash && c == '\n') {
backslash = false;
} else {
str = lisp_realloc(str, ++str_len + 1);
int to_add = c;
if (backslash) {
switch (c) {
case 'n':
to_add = '\n';
c = '\n';
break;
case 't':
to_add = '\t';
c = '\t';
break;
case 'r':
to_add = '\r';
c = '\r';
break;
case '0':
to_add = '\0';
c = '\0';
break;
case '"':
to_add = '"';
c = '"';
break;
default:
// TODO make this point at the correct thing
READ_ERROR(state, 1, "unknown escape sequence");
lisp_free(str);
return Qnil;
READ_ERROR(state, 1, "unknown escape sequence");
}
}
backslash = false;
str[str_len - 1] = to_add;
str[str_len - 1] = c;
}
}
str[str_len] = '\n';
@ -251,6 +254,7 @@ static LispVal *read_number_or_symbol(struct ReadState *state, int base) {
bool has_decimal = false;
const char *number_start = state->head;
const char *exp_start = NULL;
bool had_number = false;
int c;
while (!is_symbol_end(c = peekc(state))) {
popc(state);
@ -262,6 +266,7 @@ static LispVal *read_number_or_symbol(struct ReadState *state, int base) {
if (base == INVALID_BASE) {
goto change_to_symbol;
}
had_number = false;
number_start = state->head;
} else if (c == '.') {
if (base != ANY_BASE || has_decimal || exp_start) {
@ -275,13 +280,19 @@ static LispVal *read_number_or_symbol(struct ReadState *state, int base) {
}
// fallthrough
} else if (!is_base_char(base, c)) {
if ((c == 'e' || c == 'E') && !exp_start && base == ANY_BASE) {
if ((c == 'e' || c == 'E') && !exp_start && base == ANY_BASE
&& had_number) {
exp_start = state->head;
} else {
goto change_to_symbol;
}
} else {
had_number = true;
}
}
if (!had_number) {
goto change_to_symbol;
}
size_t len = state->head - number_start;
// ceil(# bytes in size_t / 3)
// This works because log10(2^n) is O(n) for k=3