From 75b584c53a26804332d71f606cf4490fb1af0dda Mon Sep 17 00:00:00 2001 From: Sudipto Mallick Date: Sun, 25 Oct 2020 16:12:55 -0400 Subject: adding repl --- lith.c | 61 ++++++++++++---------- lith.h | 2 +- main.c | 178 ++++++++++++++++++++++++++++++++++++++++++++++++++++------------- 3 files changed, 177 insertions(+), 64 deletions(-) diff --git a/lith.c b/lith.c index 7eefa37..670a05c 100644 --- a/lith.c +++ b/lith.c @@ -184,46 +184,46 @@ static lith_value *read_expr(lith_st *L, char *start, char **end); static lith_value *read_list_expr(lith_st *L, char *start, char **end) { - lith_value *p, *r, *v; + lith_value *p, *expr, *list; char *t; *end = start; - v = p = L->nil; + list = p = L->nil; for (;;) { lex(L, *end, &t, end); if (LITH_IS_ERR(L)) return NULL; - if (*t == ')') return v; + if (*t == ')') return list; if (*t == '.' && (*end - t == 1)) { if (LITH_IS_NIL(p)) { lith_simple_error(L, LITH_ERR_SYNTAX, "improper lists do not start with '.'"); - lith_free_value(v); + lith_free_value(list); return NULL; } - r = read_expr(L, *end, end); + expr = read_expr(L, *end, end); if (LITH_IS_ERR(L)) { - lith_free_value(v); + lith_free_value(list); return NULL; } - LITH_CDR(p) = r; + LITH_CDR(p) = expr; lex(L, *end, &t, end); if (LITH_IS_ERR(L) || (*t != ')')) { lith_simple_error(L, LITH_ERR_SYNTAX, "expecting ')' at the end of this improper list"); - lith_free_value(v); + lith_free_value(list); return NULL; } - return v; + return list; } - r = read_expr(L, t, end); + expr = read_expr(L, t, end); if (LITH_IS_ERR(L)) { - lith_free_value(v); + lith_free_value(list); return NULL; } if (LITH_IS_NIL(p)) { - v = LITH_CONS(L, r, L->nil); - p = v; + list = LITH_CONS(L, expr, L->nil); + p = list; } else { - LITH_CDR(p) = LITH_CONS(L, r, L->nil); + LITH_CDR(p) = LITH_CONS(L, expr, L->nil); p = LITH_CDR(p); } } @@ -241,15 +241,14 @@ static lith_value *read_expr(lith_st *L, char *start, char **end) lith_simple_error(L, LITH_ERR_SYNTAX, "unbalanced parenthesis, expected an expression"); return NULL; } else if ((*t == '\'') || (*t == '@') || (*t == ',') || (*t == '`')) { - s = ((*t == '\'') - ? "quote" - : (((*t == '@') || (*t == '`')) - ? "quasiquote" - : ((*t == ',') - ? ((t[1] == '@') + if (*t == '\'') + s = "quote"; + else if ((*t == '@') || (*t == '`')) + s = "quasiquote"; + else if (*t == ',') + s = (t[1] == '@') ? "unquote-splicing" - : "unquote") - : "???" ))); + : "unquote"; p = LITH_CONS(L, lith_get_symbol(L, s), L->nil); v = read_expr(L, *end, end); if (!v) { lith_free_value(p); return NULL; } @@ -1110,6 +1109,12 @@ lith_value *lith_eval_expr(lith_st *L, lith_env *V, lith_value *expr) if (!lith_expect_nargs(L, "quote", 1, rest, 1)) return NULL; return lith_copy_value(L, LITH_CAR(rest)); + } else if (LITH_SYM_EQ(f, "eval!")) { + if (!lith_expect_nargs(L, "eval!", 1, rest, 1)) + return NULL; + val = lith_eval_expr(L, V, LITH_CAR(rest)); + if (!val) return NULL; + return lith_eval_expr(L, V, val); } else if (LITH_SYM_EQ(f, "if")) { if (!lith_expect_nargs(L, "if", 3, rest, 1)) return NULL; val = lith_eval_expr(L, V, LITH_CAR(rest)); @@ -1264,18 +1269,20 @@ lith_value *lith_apply(lith_st *L, lith_value *f, lith_value *args) return r; } -void lith_run_string(lith_st *L, lith_env *V, char *input) +void lith_run_string(lith_st *L, lith_env *V, char *input, int repl) { char *end; lith_value *expr, *res; end = input; - L->filename = "<>"; + L->filename = repl ? "<>" : "<>"; while (!LITH_IS_ERR(L)) { if ((expr = lith_read_expr(L, end, &end))) { - printf(">> "); - lith_print_value(expr, stdout); - putchar('\n'); + if (!repl) { + printf(">> "); + lith_print_value(expr, stdout); + putchar('\n'); + } if ((res = lith_eval_expr(L, V, expr))) { printf("-> "); lith_print_value(res, stdout); diff --git a/lith.h b/lith.h index 719374e..3a43bbc 100644 --- a/lith.h +++ b/lith.h @@ -157,7 +157,7 @@ void lith_fill_env(lith_st *, lith_lib); int lith_expect_type(lith_st *, char *, size_t, lith_valtype, lith_value *); int lith_expect_nargs(lith_st *, char *, size_t, lith_value *, int); -void lith_run_string(lith_st *, lith_env *, char *); +void lith_run_string(lith_st *, lith_env *, char *, int); void lith_run_file(lith_st *, lith_env *, char *); #endif /* lith_h */ diff --git a/main.c b/main.c index dd2e824..80706e5 100644 --- a/main.c +++ b/main.c @@ -8,80 +8,186 @@ static void show_version(void) { - fprintf(stderr, "lith version %s: a small lisp-like language interpreter\n", LITH_VERSION_STRING); + fprintf(stderr, + "lith version %s: a small lisp-like language interpreter\n", + LITH_VERSION_STRING); } static void show_help(char *progname) { show_version(); - fprintf(stderr, "usage: %s [OPTIONS] [FILES] ...\n", progname); + fprintf(stderr, + "usage: \n" + " %s [-h | --help] [-v | --version] [-i | --interactive]\n" + " %s [(-e | --evaluate) expr ...]\n" + " %s [--] FILE [ARGS] ...\n\n", + progname, progname, progname); fprintf(stderr, "Available options: \n\n" - " -e \n" - " --evaluate \n" - " evaluate the \n\n" + " -e expr ...\n" + " --evaluate expr ...\n" + " evaluate the expression(s)\n\n" " -h, --help\n" " show this help\n\n" + " -i, --interactive\n" + " run an interactive session (REPL)\n\n" " -v, --version\n" " show version\n\n" ""); } +static lith_value *get_list_of_arguments(lith_st *L, char **arg) +{ + lith_value *arguments, *cur, *str; + arguments = cur = L->nil; + if (!cur) + return NULL; + for (; *arg; arg++) { + str = lith_make_string(L, *arg, strlen(*arg)); + if (!str || LITH_IS_ERR(L)) { + lith_free_value(arguments); + return NULL; + } + if (LITH_IS_NIL(cur)) { + arguments = LITH_CONS(L, str, L->nil); + cur = arguments; + } else { + LITH_CDR(cur) = LITH_CONS(L, str, L->nil); + cur = LITH_CDR(cur); + } + } + return arguments; +} + +static char *read_line(int *line_empty) +{ + size_t length = 0, capacity = 0; + int c; + char *start = NULL, *cur = NULL, *tmp; + while (((c = getchar()) != EOF) && (c != '\n')) { + if ((length + 1) >= capacity) { + tmp = realloc(start, capacity += BUFSIZ); + if (!tmp) { + free(start); + return NULL; + } + start = tmp; + cur = start + length; + } + *cur++ = c; + ++length; + } + if (cur) *cur = 0; + *line_empty = !start && (c == '\n'); + return start; +} + int main(int argc, char **argv) { - int ret; + int ret, empty_line; + size_t len; lith_st T, *L; - lith_env *V, *W; - char **arg, *a; + lith_env *V; + lith_value *arguments; + char **args, *opt, **expr, *filename, *line; + + enum { LITH__REPL, LITH__EXPR, LITH__RUN_FILE } state; if (argc < 2) { show_help(argv[0]); - return 8; + return 2; } - - a = argv[1]; - if (a[0] == '-') { - if (!strcmp(a, "-v") || !strcmp(a, "--version")) { + + opt = argv[1]; + #define OPT(short_form, long_form) \ + ((strcmp(opt, short_form) == 0) \ + || (strcmp(opt, long_form) == 0)) + if (opt[0] == '-') { + if (OPT("-v", "--version")) { show_version(); return 0; - } else if (!strcmp(a, "-h") || !strcmp(a, "--help")) { + } else if (OPT("-h", "--help")) { show_help(argv[0]); return 0; + } else if (OPT("-i", "--interactive")) { + state = LITH__REPL; + } else if (OPT("-e", "--evaluate")) { + state = LITH__EXPR; + if (!argv[2]) { + fprintf(stderr, + "lith: expecting at least one argument for '%s'\n", argv[1]); + return 3; + } + expr = argv+2; + } else if (!strcmp(opt, "--")) { + if (!argv[2]) { + fprintf(stderr, "lith: expecting filename after '--'\n"); + return 4; + } + state = LITH__RUN_FILE; + filename = argv[2]; + args = argv+3; + } else { + fprintf(stderr, + "lith: invalid option '%s': " + "try '%s --help' for available options\n", + argv[1], argv[0]); + return 5; } + } else { + state = LITH__RUN_FILE; + filename = argv[1]; + args = argv+2; } + #undef OPT - ret = 0; L = &T; lith_init(L); - W = lith_new_env(L, L->global); + V = lith_new_env(L, L->global); lith_run_file(L, L->global, "lib.lith"); - if (LITH_IS_ERR(L)) ret |= 16; + if (LITH_IS_ERR(L)) + return 6; - for (arg = argv+1; arg < argv+argc; arg++) { - if ((*arg)[0] != '-') { - V = lith_new_env(L, W); - lith_run_file(L, V, *arg); - lith_free_env(V); - if (LITH_IS_ERR(L)) ret |= 64; - lith_clear_error_state(L); - } else if (!strcmp(*arg, "-e") || !strcmp(*arg, "--evaluate")) { - if (!*++arg) { - fprintf(stderr, "lith: expecting an argument for '%s'\n", *--arg); + switch (state) { + case LITH__EXPR: + for (; *expr; expr++) { + lith_run_string(L, V, *expr, 0); + if (LITH_IS_ERR(L)) { + ret |= 8; break; } - V = lith_new_env(L, W); - lith_run_string(L, V, *arg); - lith_free_env(V); - if (LITH_IS_ERR(L)) ret |= 32; - lith_clear_error_state(L); - } else { - fprintf(stderr, "lith: invalid option '%s': try '%s --help' for available options\n", *arg, argv[0]); + } + break; + case LITH__RUN_FILE: + arguments = get_list_of_arguments(L, args); + if (!arguments) { + ret |= 16; break; } + lith_env_put(L, V, lith_get_symbol(L, "arguments"), arguments); + lith_run_file(L, V, filename); + break; + case LITH__REPL: + show_version(); + for (;;) { + printf("lith> "); + line = read_line(&empty_line); + if (empty_line) continue; + if (!line) { + printf("\nBye!\n"); + break; + } + lith_run_string(L, V, line, 1); + free(line); + if (LITH_IS_ERR(L)) + lith_clear_error_state(L); + } + break; } - - lith_free_env(W); + + lith_free_env(V); lith_free(L); return ret; } + -- cgit 1.4.1-2-gfad0