aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp.c105
-rw-r--r--src/interp.h4
-rw-r--r--src/main.c3
-rw-r--r--src/parser.c64
-rw-r--r--src/parser.h3
5 files changed, 176 insertions, 3 deletions
diff --git a/src/interp.c b/src/interp.c
index 2ccc08b..d4e0373 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -56,6 +56,8 @@ void Interp_init(Interp *self) {
self->stack = lisp_cons(self, self->top_level, self->nil);
self->reg = self->nil;
+ Interp_add_primitive(self, "setq", primitive_setq);
+ Interp_add_primitive(self, "let", primitive_let);
Interp_add_primitive(self, "car", primitive_car);
Interp_add_primitive(self, "cdr", primitive_cdr);
Interp_add_primitive(self, "cons", primitive_cons);
@@ -189,6 +191,7 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i
}
}
+
const char* lisp_to_string(Interp *interp, SExpRef val) {
str_builder_t sb;
Int2IntHashTable visited;
@@ -397,6 +400,92 @@ SExpRef primitive_sub(Interp *interp, SExpRef args) {
return new_error(interp, "-: wrong argument number.\n");
}
+// TODO:
+// - setq
+// - cond
+// - if
+// - while
+// - lambda
+// - defun
+// - funcall
+// - apply
+// - defvar
+// - defmacro
+// - macroexpand-1
+
+SExpRef primitive_setq(Interp *interp, SExpRef args) {
+ if (lisp_length(interp, args) != 2) goto error;
+ SExpRef name = CAR(args);
+ SExpRef exp = CADR(args);
+ if (REF(name)->type != kSymbolSExp) goto error;
+ SExpRef value = lisp_eval(interp, exp);
+ if (ERRORP(value)) return value;
+ lisp_setq(interp, REF(name)->str, value);
+ return NIL;
+error:
+ return new_error(interp, "setq: syntax error.\n");
+}
+
+static const char *binding_name(Interp *interp, SExpRef binding) {
+ SExpRef namesym = REF(binding)->binding.name;
+ return REF(namesym)->str;
+}
+
+static bool is_binding_repeat(Interp *interp, SExpRef sym, SExpRef env) {
+ SExpRef binding = REF(env)->env.bindings;
+ while (!NILP(binding)) {
+ if (strcmp(REF(sym)->str, binding_name(interp, binding)) == 0) return true;
+ binding = REF(binding)->binding.next;
+ }
+ return false;
+}
+
+SExpRef primitive_let(Interp *interp, SExpRef args) {
+ if (lisp_length(interp, args) < 1) goto error;
+ SExpRef bindings = CAR(args);
+ SExpRef env = new_env(interp);
+ REF(env)->env.parent = CAR(interp->stack);
+
+ SExpRef iter = bindings;
+ while (!NILP(iter)) {
+ SExpRef x = CAR(iter);
+ if (!lisp_check_list(interp, x)) goto error;
+ if (lisp_length(interp, x) != 2) goto error;
+ if (REF(CAR(x))->type != kSymbolSExp) goto error;
+ if (is_binding_repeat(interp, CAR(x), env)) goto error;
+ SExpRef binding = new_binding(interp, CAR(x), NIL);
+ REF(binding)->binding.next = REF(env)->env.bindings;
+ REF(env)->env.bindings = binding;
+ iter = CDR(iter);
+ }
+ interp->stack = CONS(env, interp->stack);
+
+ iter = bindings;
+ while (!NILP(iter)) {
+ SExpRef x = CAR(iter);
+ SExpRef val = lisp_eval(interp, CADR(x));
+ if (REF(val)->type == kErrSExp) goto end;
+ lisp_setq(interp, REF(CAR(x))->str, val);
+ iter = CDR(iter);
+ }
+
+ SExpRef body = CDR(args);
+ SExpRef ret = NIL;
+ iter = body;
+ while (!NILP(iter)) {
+ SExpRef exp = CAR(iter);
+ ret = lisp_eval(interp, exp);
+ if (REF(ret)->type == kErrSExp) goto end;
+ iter = CDR(iter);
+ }
+end:
+ interp->stack = CDR(interp->stack);
+ return ret;
+
+error:
+ return new_error(interp, "let: syntax error. \n");
+}
+
SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
SExpRef ret;
SExpType type;
@@ -459,6 +548,22 @@ SExpRef new_sexp(Interp *interp) {
return (SExpRef){idx};
}
+SExpRef new_env(Interp *interp) {
+ SExpRef ret = new_sexp(interp);
+ REF(ret)->type = kEnvSExp;
+ REF(ret)->env.parent = NIL;
+ REF(ret)->env.bindings = NIL;
+ return ret;
+}
+
+SExpRef new_binding(Interp *interp, SExpRef sym, SExpRef val) {
+ SExpRef ret = new_sexp(interp);
+ REF(ret)->type = kBindingSExp;
+ REF(ret)->binding.name = sym;
+ REF(ret)->binding.value = val;
+ return ret;
+}
+
SExpRef new_boolean(Interp *interp, bool val) {
SExpRef ret = new_sexp(interp);
REF(ret)->type = kBooleanSExp;
diff --git a/src/interp.h b/src/interp.h
index 03cdf7f..3b3004d 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -40,6 +40,8 @@ SExp* Interp_ref(Interp *self, SExpRef ref);
void Interp_gc(Interp *self, SExpRef tmp_root);
void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn);
+SExpRef primitive_setq(Interp *interp, SExpRef sexp);
+SExpRef primitive_let(Interp *interp, SExpRef sexp);
SExpRef primitive_car(Interp *interp, SExpRef sexp);
SExpRef primitive_cdr(Interp *interp, SExpRef sexp);
SExpRef primitive_cons(Interp *interp, SExpRef sexp);
@@ -69,6 +71,8 @@ SExpRef new_integer(Interp *ctx, int64_t val);
SExpRef new_real(Interp *ctx, double val);
SExpRef new_string(Interp *ctx, const char *val);
SExpRef new_symbol(Interp *ctx, const char *val);
+SExpRef new_env(Interp *ctx);
+SExpRef new_binding(Interp *ctx, SExpRef name, SExpRef val);
SExpRef new_list1(Interp *ctx, SExpRef e1);
SExpRef new_list2(Interp *ctx, SExpRef e1, SExpRef e2);
SExpRef new_list3(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3);
diff --git a/src/main.c b/src/main.c
index ecbc2f4..9c05ee5 100644
--- a/src/main.c
+++ b/src/main.c
@@ -10,11 +10,10 @@ int main() {
Parser_init(&parser);
parser.ctx = &interp;
- Parser_set_file(&parser, stdin);
+ Parser_set_readline(&parser);
SExpRef sexp, res;
ParseResult parse_result;
while (1) {
- printf("> ");
parse_result = parse_sexp(&parser);
if (parse_result.errmsg != NULL) {
if (Parser_peek(&parser) == EOF) goto end;
diff --git a/src/parser.c b/src/parser.c
index 2130b01..9ed583d 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -1,10 +1,13 @@
#include "parser.h"
-#include "sexp.h"
#include <ctype.h>
#include <stdlib.h>
#include <stdarg.h>
+#include <readline/readline.h>
+
+#include "sexp.h"
+
#define BUFSIZE 1024
static void skip_spaces(Parser *parser) {
@@ -36,6 +39,7 @@ void Parser_init(Parser *parser) {
}
void Parser_free(Parser *parser) {
+ if (parser->parse_type == kParseReadline) free((void*)parser->string);
free(parser->token_buf);
free(parser->errmsg_buf);
}
@@ -51,6 +55,13 @@ void Parser_set_file(Parser *parser, FILE *fp) {
parser->fp = fp;
}
+void Parser_set_readline(Parser *parser) {
+ parser->parse_type = kParseReadline;
+ parser->string = NULL;
+ parser->str_cursor = NULL;
+ parser->readline_eof = false;
+}
+
int Parser_getchar(Parser *ctx) {
if (ctx->parse_type == kParseString) {
if (*ctx->str_cursor == '\0') return EOF;
@@ -59,6 +70,31 @@ int Parser_getchar(Parser *ctx) {
return ret;
} else if (ctx->parse_type == kParseFile) {
return fgetc(ctx->fp);
+ } else if (ctx->parse_type == kParseReadline) {
+ if (ctx->readline_eof) return EOF;
+ if (ctx->string == NULL) {
+ char *s = readline(">>> ");
+ if (s == NULL) {
+ ctx->readline_eof = true;
+ return EOF;
+ }
+ ctx->string = s;
+ ctx->str_cursor = s;
+ }
+ if (*ctx->str_cursor == '\0') {
+ char *s = readline(">>> ");
+ if (s == NULL) {
+ ctx->readline_eof = true;
+ return EOF;
+ }
+ free((void*)ctx->string);
+ ctx->string = s;
+ ctx->str_cursor = s;
+ return '\n';
+ }
+ int c = *ctx->str_cursor;
+ ctx->str_cursor++;
+ return c;
}
return EOF;
}
@@ -73,6 +109,22 @@ int Parser_peek(Parser *ctx) {
if (ret == EOF) return EOF;
ungetc(ret, ctx->fp);
return ret;
+ } else if (ctx->parse_type == kParseReadline) {
+ if (ctx->readline_eof) return EOF;
+ if (ctx->string == NULL) {
+ char *s = readline(">>> ");
+ if (s == NULL) {
+ ctx->readline_eof = true;
+ return EOF;
+ }
+ ctx->string = s;
+ ctx->str_cursor = s;
+ }
+ if (*ctx->str_cursor == '\0') {
+ return '\n';
+ }
+ int c = *ctx->str_cursor;
+ return c;
}
return EOF;
}
@@ -243,6 +295,16 @@ static ParseResult parse_token(Parser *parser, const char *token) {
}
if (token[0] == '#') {
if (len < 2) return ParseErr(parser, "Expect boolean or character.\n");
+ if (token[1] == '\'') {
+ if (len < 3) return ParseErr(parser, "Expect a symbol.\n");
+ if (!is_symbol_init(token[2])) return ParseErr(parser, "Expect a symbol.\n");
+ for (int i = 3; i < len; i++) {
+ if (!is_symbol_subsequent(token[i])) return ParseErr(parser, "Expect a symbol.\n");
+ }
+ SExpRef funcsym = new_symbol(parser->ctx, "function");
+ SExpRef sym = new_symbol(parser->ctx, token+2);
+ return ParseOk(lisp_cons(parser->ctx, funcsym, lisp_cons(parser->ctx, sym, parser->ctx->nil)));
+ }
if (token[1] == 't') return ParseOk(new_boolean(parser->ctx, true));
if (token[1] == 'f') return ParseOk(new_boolean(parser->ctx, false));
if (token[1] == '\\') {
diff --git a/src/parser.h b/src/parser.h
index cefc946..ff55f90 100644
--- a/src/parser.h
+++ b/src/parser.h
@@ -9,6 +9,7 @@
typedef enum {
kParseString,
kParseFile,
+ kParseReadline,
} ParseType;
typedef struct {
@@ -21,6 +22,7 @@ typedef struct {
struct {
const char *string;
const char *str_cursor;
+ bool readline_eof;
};
FILE *fp;
};
@@ -32,6 +34,7 @@ int Parser_getchar(Parser *self);
int Parser_peek(Parser *self);
void Parser_set_string(Parser *parser, const char *str);
void Parser_set_file(Parser *parser, FILE *fp);
+void Parser_set_readline(Parser *parser);
typedef struct {
SExpRef val;
generated by cgit v1.0 at 2025-12-29 17:24:51 +0000