adding repl

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 = "<<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);
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 <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;
 }
+