improve parser, add numeric = primitive

- parse symbols such as "+" ,"-", and "1+"
- parse 'quoted expressions

lake.c

@@ -27,143 +27,19 @@ static LakeBool _F = { { TYPE_BOOL, sizeof(LakeBool) }, FALSE };
 LakeBool *T = &_T;
 LakeBool *F = &_F;
 
-static LakeVal *prim_nullP(LakeList *args)
+char *type_name(LakeVal *expr)
 {
-    LakeVal *val = list_shift(args);
+    static char *type_names[9] = { "nil", "symbol", "boolean", "integer", "string", "list",
-    LakeBool *is_null = IS(TYPE_LIST, val) && LIST_N(LIST(val)) == 0 ? T : F;
+                                   "dotted-list", "primitive", "function"
-    return VAL(is_null);
+                                 };
+
+    return type_names[expr->type];
 }
 
-static LakeVal *prim_pairP(LakeList *args)
+void print(LakeVal *expr)
 {
-    LakeVal *val = list_shift(args);
+    /* printf("[%s]\n", type_name(expr)); */
-    LakeBool *is_pair = IS(TYPE_LIST, val) && LIST_N(LIST(val)) > 0 ? T : F;
+    printf("%s\n", repr(expr));
-    return VAL(is_pair);
-}
-
-static LakeVal *prim_not(LakeList *args)
-{
-    LakeVal *val = list_shift(args);
-    LakeBool *not = IS_FALSE(val) ? T : F;
-    return VAL(not);
-}
-
-static LakeVal *prim_add(LakeList *args)
-{
-    int result = 0;
-    size_t n = LIST_N(args);
-    size_t i;
-    for (i = 0; i < n; ++i) {
-        LakeVal *v = LIST_VAL(args, i);
-        if (!IS(TYPE_INT, v)) {
-            ERR("argument %zu is not an integer: %s", i, repr(v));
-            return NULL;
-        }
-        result += INT_VAL(INT(v));
-    }
-    return VAL(int_from_c(result));
-}
-
-static LakeVal *prim_sub(LakeList *args)
-{
-    size_t n = LIST_N(args);
-    
-    if (n < 1) {
-        ERR("- requires at least one argument");
-        return NULL;
-    }
-    
-    int result = 0;
-    size_t i;
-    for (i = 0; i < n; ++i) {
-        LakeVal *v = LIST_VAL(args, i);
-        if (!IS(TYPE_INT, v)) {
-            ERR("argument %zu is not an integer: %s", i, repr(v));
-            return NULL;
-        }
-        result -= INT_VAL(INT(v));
-    }
-    return VAL(int_from_c(result));
-}
-
-static LakeVal *prim_mul(LakeList *args)
-{
-    int result = 1;
-    size_t n = LIST_N(args);
-    size_t i;
-    for (i = 0; i < n; ++i) {
-        LakeVal *v = LIST_VAL(args, i);
-        if (!IS(TYPE_INT, v)) {
-            ERR("argument %zu is not an integer: %s", i, repr(v));
-            return NULL;
-        }
-        result *= INT_VAL(INT(v));
-    }
-    return VAL(int_from_c(result));
-}
-
-#define DIVIDE_BY_ZERO() ERR("divide by zero")
-
-static LakeVal *prim_div(LakeList *args)
-{
-    size_t n = LIST_N(args);
-    
-    if (n < 1) {
-        ERR("/ requires at least one argument");
-        return NULL;
-    }
-    
-    LakeVal *v = LIST_VAL(args, 0);
-    if (!IS(TYPE_INT, v)) {
-        ERR("argument 0 is not an integer: %s", repr(v));
-        return NULL;
-    }
-    int result = INT_VAL(INT(v));
-
-    if (n == 1) {
-        if (result == 0) {
-            DIVIDE_BY_ZERO();
-            return NULL;
-        }
-        result = 1 / result;
-    }
-    else {
-        size_t i;
-        for (i = 1; i < n; ++i) {
-            v = LIST_VAL(args, i);
-            if (!IS(TYPE_INT, v)) {
-                ERR("argument %zu is not an integer: %s", i, repr(v));
-                return NULL;
-            }
-            int val = INT_VAL(INT(v));
-            if (val == 0) {
-                DIVIDE_BY_ZERO();
-                return NULL;
-            }
-            result /= val;
-        }
-    }
-    return VAL(int_from_c(result));
-}
-
-static Env *primitive_bindings(void)
-{
-    #define DEFINE(name, fn, arity) env_define(env, sym_intern(name), VAL(prim_make(name, arity, fn)))
-    
-    Env *env = env_toplevel();
-    DEFINE("null?", prim_nullP, 1);
-    DEFINE("pair?", prim_pairP, 1);
-    DEFINE("not", prim_not, 1);
-    DEFINE("+", prim_add, ARITY_VARARGS);
-    DEFINE("-", prim_sub, ARITY_VARARGS);
-    DEFINE("*", prim_mul, ARITY_VARARGS);
-    DEFINE("/", prim_div, ARITY_VARARGS);
-    return env;
-}
-
-void print(LakeVal *val)
-{
-    puts(repr(val));
 }
 
 static LakeVal *prompt_read(char *prompt)
@@ -260,6 +136,10 @@ char *repr(LakeVal *expr)
         s = dlist_repr(DLIST(expr));
         break;
     
+    case TYPE_PRIM:
+        s = prim_repr(PRIM(expr));
+        break;
+    
     case TYPE_FN:
         s = fn_repr(FN(expr));
         break;
@@ -276,7 +156,8 @@ int main (int argc, char const *argv[])
 {
     if (argc == 1) {
         run_repl();
-    } else {
+    }
+    else {
         run_one_then_repl(argc, argv);
     }
     return 0;

list.c

@@ -80,7 +80,8 @@ LakeVal *list_set(LakeList *list, size_t i, LakeVal *val)
 {
     if (i >= 0 && i < list->n) {
         list->vals[i] = val;
-    } else {
+    }
+    else {
         ERR("list_set: index %zu is out of bounds (%zu)", i, list->n);
     }
     return NULL;

parse.c

@@ -23,6 +23,7 @@ struct context {
     char *s;
     size_t n;
     size_t i;
+    size_t mark;
 };
 typedef struct context Ctx;
 
@@ -30,7 +31,7 @@ static LakeVal *_parse_expr(Ctx *ctx);
 
 LakeVal *parse_expr(char *s, size_t n)
 {
-    Ctx ctx = { s, n, 0 };
+    Ctx ctx = { s, n, 0, 0 };
     LakeVal *result = _parse_expr(&ctx);
     if (ctx.i < ctx.n) {
         char *trailing = ctx.s + ctx.i;
@@ -70,26 +71,21 @@ static char ch(Ctx *ctx, char expected)
     DIE("parse error, expected '%c' got '%c'", expected, c);
 }
 
-static int maybe_spaces(Ctx *ctx)
+static void mark(Ctx *ctx)
 {
-    char *p;
+    ctx->mark = ctx->i;
-    while ((p = strchr(" \r\n\t", peek(ctx))) != NULL) {
-        consume1(ctx);
-    }
-    return 1;
 }
-/*
+
-static int whitespace(Ctx *ctx)
+static void backtrack(Ctx *ctx)
 {
-    int result = 0;
+    ctx->i = ctx->mark;
-    char *p;
-    while ((p = strchr(" \r\n\t", peek(ctx))) != NULL) {
-        consume1(ctx);
-        result = 1;
-    }
-    return result;
 }
-*/
+
+static gboolean is_space(c)
+{
+    return strchr(" \r\n\t", c) != NULL;
+}
+
 static gboolean is_letter(char c)
 {
     return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z');
@@ -105,6 +101,16 @@ static gboolean is_digit(char c)
     return c >= '0' && c <= '9';
 }
 
+static gboolean is_sym_char(char c)
+{
+    return is_letter(c) || is_symbol(c) || is_digit(c);
+}
+
+static gboolean is_newline(char c)
+{
+    return c == '\n' || c == '\r';
+}
+
 static char *parse_while(Ctx *ctx, gboolean (*is_valid)(char))
 {
     size_t n = 8;
@@ -126,27 +132,41 @@ static char *parse_while(Ctx *ctx, gboolean (*is_valid)(char))
     return s;
 }
 
+static int maybe_spaces(Ctx *ctx)
+{
+    while (is_space(peek(ctx))) {
+        consume1(ctx);
+    }
+    return 1;
+}
+
 static LakeVal *parse_int(Ctx *ctx)
 {
+    mark(ctx);
     int n = 0;
     char c = peek(ctx);
     char sign = c == '-' ? -1 : 1;
     if (c == '-' || c == '+') {
         consume1(ctx);
+        /* if not followed by a digit it's a symbol */
+        if (!is_digit(peek(ctx))) {
+            backtrack(ctx);
+            return NULL;
+        }
     }
     while (is_digit(c = peek(ctx))) {
         n *= 10;
         n += c - '0';
         consume1(ctx);
     }
+    /* if we're looking at a symbol character bail, it's not a number */
+    if (is_sym_char(peek(ctx))) {
+        backtrack(ctx);
+        return NULL;
+    }
     return VAL(int_from_c(sign * n));
 }
 
-static gboolean is_sym_char(char c)
-{
-    return is_letter(c) || is_symbol(c) || is_digit(c);
-}
-
 static LakeVal *parse_sym(Ctx *ctx)
 {
 	LakeVal *val;
@@ -161,9 +181,11 @@ static LakeVal *parse_sym(Ctx *ctx)
     s[i] = '\0';
 	if (g_strcmp0(s, "#t") == 0) {
 		val = VAL(T);
-	} else if (g_strcmp0(s, "#f") == 0) {
+	}
+	else if (g_strcmp0(s, "#f") == 0) {
 		val = VAL(F);
-	} else {
+	}
+	else {
 		val = VAL(sym_intern(s));
 	}
     return val;
@@ -231,7 +253,7 @@ static LakeVal* parse_list(Ctx *ctx)
     char c;
     while ((c = peek(ctx)) != ')') {
         if (c == PARSE_EOF) {
-            printf("error: end of input while parsing list");
+            ERR("end of input while parsing list");
             list_free(list);
             ctx-> i = ctx->n;
             return NULL;
@@ -263,9 +285,18 @@ static LakeVal* parse_list(Ctx *ctx)
     return VAL(list);
 }
 
+static LakeVal *parse_quoted(Ctx *ctx)
+{
+    ch(ctx, '\'');
+    LakeList *list = list_make();
+    list_append(list, VAL(sym_intern("quote")));
+    list_append(list, _parse_expr(ctx));
+    return VAL(list);
+}
+
 static gboolean is_not_newline(char c)
 {
-    return !(c == '\n' || c == '\r');
+    return !is_newline(c);
 }
 
 static void parse_comment(Ctx *ctx)
@@ -277,8 +308,12 @@ static LakeVal *_parse_expr(Ctx *ctx)
 {
     LakeVal *result = NULL;
     char c = peek(ctx);
-    if (c >= '0' && c <= '9') {
+    /* try to parse a number, if that fails parse a symbol */
+    if ((c >= '0' && c <= '9') || c == '-' || c == '+') {
         result = VAL(parse_int(ctx));
+        if (result == NULL) {
+            result = parse_sym(ctx);
+        }
     }
     else if (is_letter(c) || is_symbol(c)) {
         result = parse_sym(ctx);
@@ -286,11 +321,9 @@ static LakeVal *_parse_expr(Ctx *ctx)
     else if (c == '"') {
         result = parse_str(ctx);
     }
-    /* TODO: quote
     else if (c == '\'') {
         result = parse_quoted(ctx);
     }
-    */
     else if (c == '(') {
         result = parse_list(ctx);
     }

primitive.c

@@ -7,6 +7,9 @@
   *
   */
 
+#include <glib.h>
+#include <stdlib.h>
+#include "env.h"
 #include "lake.h"
 #include "primitive.h"
 
@@ -26,3 +29,154 @@ LakePrimitive *prim_make(char *name, int arity, lake_fn fn)
     prim->fn = fn;
     return prim;
 }
+
+char *prim_repr(LakePrimitive *prim)
+{
+    return g_strdup_printf("<#primitive:%s(%d)>", prim->name, prim->arity);
+}
+
+static LakeVal *prim_nullP(LakeList *args)
+{
+    LakeVal *val = list_shift(args);
+    LakeBool *is_null = IS(TYPE_LIST, val) && LIST_N(LIST(val)) == 0 ? T : F;
+    return VAL(is_null);
+}
+
+static LakeVal *prim_pairP(LakeList *args)
+{
+    LakeVal *val = list_shift(args);
+    LakeBool *is_pair = IS(TYPE_LIST, val) && LIST_N(LIST(val)) > 0 ? T : F;
+    return VAL(is_pair);
+}
+
+static LakeVal *prim_not(LakeList *args)
+{
+    LakeVal *val = list_shift(args);
+    LakeBool *not = IS_FALSE(val) ? T : F;
+    return VAL(not);
+}
+
+#define ENSURE_INT(x, i) do {                                      \
+        if (!IS(TYPE_INT, x)) {                                    \
+            ERR("argument %zu is not an integer: %s", i, repr(x)); \
+            return NULL;                                           \
+        }                                                          \
+    } while (0)
+
+
+static LakeVal *prim_add(LakeList *args)
+{
+    int result = 0;
+    size_t n = LIST_N(args);
+    size_t i;
+    for (i = 0; i < n; ++i) {
+        LakeVal *v = LIST_VAL(args, i);
+        ENSURE_INT(v, i);
+        result += INT_VAL(INT(v));
+    }
+    return VAL(int_from_c(result));
+}
+
+static LakeVal *prim_sub(LakeList *args)
+{
+    size_t n = LIST_N(args);
+    
+    if (n < 1) {
+        ERR("- requires at least one argument");
+        return NULL;
+    }
+    
+    int result = 0;
+    size_t i;
+    for (i = 0; i < n; ++i) {
+        LakeVal *v = LIST_VAL(args, i);
+        ENSURE_INT(v, i);
+        result -= INT_VAL(INT(v));
+    }
+    return VAL(int_from_c(result));
+}
+
+static LakeVal *prim_mul(LakeList *args)
+{
+    int result = 1;
+    size_t n = LIST_N(args);
+    size_t i;
+    for (i = 0; i < n; ++i) {
+        LakeVal *v = LIST_VAL(args, i);
+        ENSURE_INT(v, i);
+        result *= INT_VAL(INT(v));
+    }
+    return VAL(int_from_c(result));
+}
+
+#define DIVIDE_BY_ZERO() ERR("divide by zero")
+
+static LakeVal *prim_div(LakeList *args)
+{
+    size_t n = LIST_N(args);
+    
+    if (n < 1) {
+        ERR("/ requires at least one argument");
+        return NULL;
+    }
+    
+    LakeVal *v = LIST_VAL(args, 0);
+    ENSURE_INT(v, (size_t)0);
+    int result = INT_VAL(INT(v));
+
+    if (n == 1) {
+        if (result == 0) {
+            DIVIDE_BY_ZERO();
+            return NULL;
+        }
+        result = 1 / result;
+    }
+    else {
+        size_t i;
+        for (i = 1; i < n; ++i) {
+            v = LIST_VAL(args, i);
+            ENSURE_INT(v, i);
+            int val = INT_VAL(INT(v));
+            if (val == 0) {
+                DIVIDE_BY_ZERO();
+                return NULL;
+            }
+            result /= val;
+        }
+    }
+    return VAL(int_from_c(result));
+}
+
+static LakeVal *prim_int_eq(LakeList *args)
+{
+    gboolean result = TRUE;
+    size_t n = LIST_N(args);
+    size_t i;
+    int curr, prev;
+    for (i = 0; i < n; ++i) {
+        LakeVal *v = LIST_VAL(args, i);
+        ENSURE_INT(v, i);
+        curr = INT_VAL(INT(v));
+        if (i > 0) {
+            result = result && curr == prev;
+        }
+        prev = INT_VAL(INT(v));
+    }
+    return VAL(bool_from_int(result));
+}
+
+Env *primitive_bindings(void)
+{
+    #define DEFINE(name, fn, arity) env_define(env, sym_intern(name), VAL(prim_make(name, arity, fn)))
+    
+    Env *env = env_toplevel();
+    DEFINE("null?", prim_nullP, 1);
+    DEFINE("pair?", prim_pairP, 1);
+    DEFINE("not", prim_not, 1);
+    DEFINE("+", prim_add, ARITY_VARARGS);
+    DEFINE("-", prim_sub, ARITY_VARARGS);
+    DEFINE("*", prim_mul, ARITY_VARARGS);
+    DEFINE("/", prim_div, ARITY_VARARGS);
+    DEFINE("=", prim_int_eq, ARITY_VARARGS);
+    return env;
+}

primitive.h

@@ -10,6 +10,11 @@
 #ifndef _LAKE_PRIMITIVE_H
 #define _LAKE_PRIMITIVE_H 1
 
+#include "env.h"
+#include "lake.h"
+
 LakePrimitive *prim_make(char *name, int arity, lake_fn fn);
+char *prim_repr(LakePrimitive *prim);
+Env *primitive_bindings(void);
 
 #endif