smlckz
/
lith
mirror of https://github.com/smlckz/lith
1
0
Fork 0
Code Issues Releases Wiki Activity

adding repl

This commit is contained in:
Sudipto Mallick 2020-10-25 16:12:55 -04:00
parent 5a8c3e315e
commit 75b584c53a
3 changed files with 177 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
lith.c
View File

@ -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 = "<<string>>";
L->filename = repl ? "<<stdin>>" : "<<string>>";
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);

2
lith.h
View File

@ -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 */

178
main.c
View File

@ -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 <expr>\n"
" --evaluate <expr>\n"
" evaluate the <expr>\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;
}