add is? and equal? primitives (is? is like eq?)

src/bool.h

@@ -16,7 +16,6 @@
 LakeBool *bool_from_int(int b);
 gboolean bool_val(LakeBool *b);
 LakeStr *bool_to_str(LakeBool *b);
-LakeBool *bool_eq(LakeBool *a, LakeBool *b);
 char *bool_repr(LakeBool *b);
 LakeVal* bool_and(LakeVal *a, LakeVal *b);
 LakeVal* bool_or(LakeVal *a, LakeVal *b);

src/comment.c

@@ -7,8 +7,10 @@
   *
   */
 
+#include <glib.h>
 #include "comment.h"
 #include "lake.h"
+#include "string.h"
 
 static LakeComment *comment_alloc(void)
 {
@@ -34,3 +36,8 @@ char *comment_repr(LakeComment *comment)
 {
 	return g_strdup(STR_S(comment->text));
 }
+
+gboolean comm_equal(LakeComment *a, LakeComment *b)
+{
+    return str_equal(COMM_TEXT(a), COMM_TEXT(b));
+}

src/comment.h

@@ -10,10 +10,12 @@
 #ifndef _LAKE_COMMENT_H
 #define _LAKE_COMMENT_H 1
 
+#include <glib.h>
 #include "lake.h"
 
 LakeComment *comment_make(LakeStr *text);
 LakeComment *comment_from_c(char *text);
 char *comment_repr(LakeComment *comment);
+gboolean comm_equal(LakeComment *a, LakeComment *b);
 
 #endif

src/dlist.c

@@ -48,3 +48,12 @@ char *dlist_repr(LakeDottedList *dlist)
 	g_string_free(s, FALSE); /* don't free char data */
 	return repr;
 }
+
+gboolean dlist_equal(LakeDottedList *a, LakeDottedList *b)
+{
+    LakeVal *headA = VAL(DLIST_HEAD(a));
+    LakeVal *tailA = DLIST_TAIL(a);
+    LakeVal *headB = VAL(DLIST_HEAD(b));
+    LakeVal *tailB = DLIST_TAIL(b);
+    return lake_equal(headA, headB) && lake_equal(tailA, tailB);
+}

src/dlist.h

@@ -10,9 +10,11 @@
 #ifndef _LAKE_DLIST_H
 #define _LAKE_DLIST_H 1
 
+#include <glib.h>
 #include "lake.h"
 
 LakeDottedList *dlist_make(LakeList *head, LakeVal *tail);
 char *dlist_repr(LakeDottedList *dlist);
+gboolean dlist_equal(LakeDottedList *a, LakeDottedList *b);
 
 #endif

src/int.c

@@ -48,11 +48,6 @@ LakeInt *int_cmp(LakeInt *a, LakeInt *b)
     return result;
 }
 
-LakeBool *int_eq(LakeInt *a, LakeInt *b)
-{
-    return bool_from_int(a->val == b->val);
-}
-
 LakeStr *int_to_str(LakeInt *i)
 {
     char *s = g_strdup_printf("%d", i->val);

src/int.h

@@ -16,7 +16,6 @@ LakeInt *int_make(void);
 LakeInt *int_copy(LakeInt *i);
 LakeInt *int_from_c(int n);
 LakeInt *int_cmp(LakeInt *a, LakeInt *b);
-LakeBool *int_eq(LakeInt *a, LakeInt *b);
 LakeStr *int_to_str(LakeInt *i);
 
 #endif

src/lake.c

@@ -147,6 +147,48 @@ char *repr(LakeVal *expr)
     return s;
 }
 
+gboolean lake_is(LakeVal *a, LakeVal *b)
+{
+    if (IS(TYPE_INT, a) && IS(TYPE_INT, b)) {
+        return INT_VAL(INT(a)) == INT_VAL(INT(b));
+    }
+    if (IS_NIL(a) && IS_NIL(b)) return TRUE;
+    return a == b;
+}
+
+gboolean lake_equal(LakeVal *a, LakeVal *b)
+{
+    if (a->type != b->type) return FALSE;
+    switch (a->type) {
+
+        /* singletons can be compared directly */
+        case TYPE_SYM:
+        case TYPE_BOOL:
+        case TYPE_PRIM:
+        case TYPE_FN:
+            return a == b;
+        
+        case TYPE_INT:
+            return INT_VAL(INT(a)) == INT_VAL(INT(b));
+        
+        case TYPE_STR:
+            return str_equal(STR(a), STR(b));
+        
+        case TYPE_LIST:
+            return list_equal(LIST(a), LIST(b));
+        
+        case TYPE_DLIST:
+            return dlist_equal(DLIST(a), DLIST(b));
+        
+        case TYPE_COMM:
+            return comm_equal(COMM(a), COMM(b));
+        
+        default:
+            ERR("unknown type %d (%s)", a->type, type_name(a));
+            return FALSE;
+    }
+}
+
 static void run_repl(Env *env)
 {
     puts("Lake Scheme v" LAKE_VERSION);

src/lake.h

@@ -46,6 +46,7 @@ typedef struct lake_val LakeVal;
 
 #define VAL_SIZE(x) (VAL(x)->size)
 #define IS(t, x) (VAL(x)->type == t)
+#define IS_NIL(x) (IS(TYPE_LIST, x) && LIST_N(LIST(x)) == 0)
 
 struct lake_sym {
     LakeVal base;
@@ -113,13 +114,13 @@ typedef struct lake_dlist LakeDottedList;
 #define DLIST_HEAD(x) (x->head)
 #define DLIST_TAIL(x) (x->tail)
 
-typedef LakeVal *(*lake_fn)(LakeList *args);
+typedef LakeVal *(*lake_prim)(LakeList *args);
 
 struct lake_primitive {
 	LakeVal base;
 	char *name;
     int arity;
-	lake_fn fn;
+	lake_prim fn;
 };
 typedef struct lake_primitive LakePrimitive;
 
@@ -147,6 +148,8 @@ typedef struct lake_comment LakeComment;
 
 #define COMM_TEXT(x) (x->text)
 
+gboolean lake_is(LakeVal *a, LakeVal *b);
+gboolean lake_equal(LakeVal *a, LakeVal *b);
 char *repr(LakeVal *val);
 
 #include <stdio.h>

src/list.c

@@ -170,10 +170,16 @@ LakeInt *list_cmp(LakeList *a, LakeList *b)
     return 0;
 }
 
-LakeBool *list_eq(LakeList *a, LakeList *b)
+gboolean list_equal(LakeList *a, LakeList *b)
 {
-    /* TODO */
+    if (a == b) return TRUE;
-    return bool_from_int(a == b);
+    size_t n = LIST_N(a);
+    if (n != LIST_N(b)) return FALSE;
+    size_t i;
+    for (i = 0; i < n; ++i) {
+        if (!lake_equal(LIST_VAL(a, i), LIST_VAL(b, i))) return FALSE;
+    }
+    return TRUE;
 }
 
 LakeStr *list_to_str(LakeList *list)

src/list.h

@@ -10,6 +10,7 @@
 #ifndef _LAKE_LIST_H
 #define _LAKE_LIST_H 1
 
+#include <glib.h>
 #include <stdlib.h>
 #include "lake.h"
 #include "string.h"
@@ -28,7 +29,7 @@ LakeVal *list_pop(LakeList *list);
 LakeVal *list_shift(LakeList *list);
 LakeVal *list_unshift(LakeList *list, LakeVal *val);
 LakeInt *list_cmp(LakeList *a, LakeList *b);
-LakeBool *list_eq(LakeList *a, LakeList *b);
+gboolean list_equal(LakeList *a, LakeList *b);
 LakeStr *list_to_str(LakeList *list);
 char *list_repr(LakeList *list);
 

src/primitive.c

@@ -9,9 +9,15 @@
 
 #include <glib.h>
 #include <stdlib.h>
+#include "comment.h"
 #include "env.h"
+#include "int.h"
+#include "dlist.h"
+#include "fn.h"
+#include "list.h"
 #include "lake.h"
 #include "primitive.h"
+#include "string.h"
 
 static LakePrimitive *prim_alloc(void)
 {
@@ -21,7 +27,7 @@ static LakePrimitive *prim_alloc(void)
     return prim;
 }
 
-LakePrimitive *prim_make(char *name, int arity, lake_fn fn)
+LakePrimitive *prim_make(char *name, int arity, lake_prim fn)
 {
     LakePrimitive *prim = prim_alloc();
     prim->name = g_strdup(name);
@@ -35,21 +41,64 @@ char *prim_repr(LakePrimitive *prim)
     return g_strdup_printf("<#primitive:%s(%d)>", prim->name, prim->arity);
 }
 
-static LakeVal *prim_nullP(LakeList *args)
+static LakeVal *_car(LakeList *args)
+{
+    LakeList *list = LIST(LIST_VAL(args, 0));
+    if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
+        return LIST_VAL(list, 0);
+    }
+    ERR("not a pair: %s", list_repr(list));
+    return NULL;
+}
+
+static LakeVal *_cdr(LakeList *args)
+{
+    LakeList *list = LIST(LIST_VAL(args, 0));
+    if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
+        LakeList *cdr = list_copy(list);
+        list_shift(cdr);
+        return VAL(cdr);
+    }
+    ERR("not a pair: %s", list_repr(list));
+    return NULL;
+}
+
+static LakeVal *_cons(LakeList *args)
+{
+    LakeVal *car = LIST_VAL(args, 0);
+    LakeVal *cdr = LIST_VAL(args, 1);
+    return VAL(list_cons(car, cdr));
+}
+
+static LakeVal *_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)
+static LakeVal *_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)
+static LakeVal *_isP(LakeList *args)
+{
+    LakeVal *a = LIST_VAL(args, 0);
+    LakeVal *b = LIST_VAL(args, 1);
+    return VAL(bool_from_int(lake_is(a, b)));
+}
+
+static LakeVal *_equalP(LakeList *args)
+{
+    LakeVal *a = LIST_VAL(args, 0);
+    LakeVal *b = LIST_VAL(args, 1);
+    return VAL(bool_from_int(lake_equal(a, b)));
+}
+
+static LakeVal *_not(LakeList *args)
 {
     LakeVal *val = list_shift(args);
     LakeBool *not = IS_FALSE(val) ? T : F;
@@ -63,7 +112,7 @@ static LakeVal *prim_not(LakeList *args)
         }                                                          \
     } while (0)
 
-static LakeVal *prim_add(LakeList *args)
+static LakeVal *_add(LakeList *args)
 {
     int result = 0;
     size_t n = LIST_N(args);
@@ -76,7 +125,7 @@ static LakeVal *prim_add(LakeList *args)
     return VAL(int_from_c(result));
 }
 
-static LakeVal *prim_sub(LakeList *args)
+static LakeVal *_sub(LakeList *args)
 {
     size_t n = LIST_N(args);
     
@@ -95,7 +144,7 @@ static LakeVal *prim_sub(LakeList *args)
     return VAL(int_from_c(result));
 }
 
-static LakeVal *prim_mul(LakeList *args)
+static LakeVal *_mul(LakeList *args)
 {
     int result = 1;
     size_t n = LIST_N(args);
@@ -110,7 +159,7 @@ static LakeVal *prim_mul(LakeList *args)
 
 #define DIVIDE_BY_ZERO() ERR("divide by zero")
 
-static LakeVal *prim_div(LakeList *args)
+static LakeVal *_div(LakeList *args)
 {
     size_t n = LIST_N(args);
     
@@ -146,7 +195,7 @@ static LakeVal *prim_div(LakeList *args)
     return VAL(int_from_c(result));
 }
 
-static LakeVal *prim_int_eq(LakeList *args)
+static LakeVal *_int_eq(LakeList *args)
 {
     gboolean result = TRUE;
     size_t n = LIST_N(args);
@@ -164,33 +213,46 @@ static LakeVal *prim_int_eq(LakeList *args)
     return VAL(bool_from_int(result));
 }
 
-static LakeVal *prim_car(LakeList *args)
+static LakeVal *_int_lt(LakeList *args)
 {
-    LakeList *list = LIST(LIST_VAL(args, 0));
+    gboolean result = TRUE;
-    if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
+    size_t n = LIST_N(args);
-        return LIST_VAL(list, 0);
+    size_t i;
+    int curr, prev;
+
+    if (n > 1) {
+        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 && prev < curr;
+            }
+            prev = INT_VAL(INT(v));
+        }
     }
-    ERR("not a pair: %s", list_repr(list));
+    return VAL(bool_from_int(result));
-    return NULL;
 }
 
-static LakeVal *prim_cdr(LakeList *args)
+static LakeVal *_int_gt(LakeList *args)
 {
-    LakeList *list = LIST(LIST_VAL(args, 0));
+    gboolean result = TRUE;
-    if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
+    size_t n = LIST_N(args);
-        LakeList *cdr = list_copy(list);
+    size_t i;
-        list_shift(cdr);
+    int curr, prev;
-        return VAL(cdr);
-    }
-    ERR("not a pair: %s", list_repr(list));
-    return NULL;
-}
 
-static LakeVal *prim_cons(LakeList *args)
+    if (n > 1) {
-{
+        for (i = 0; i < n; ++i) {
-    LakeVal *car = LIST_VAL(args, 0);
+            LakeVal *v = LIST_VAL(args, i);
-    LakeVal *cdr = LIST_VAL(args, 1);
+            ENSURE_INT(v, i);
-    return VAL(list_cons(car, cdr));
+            curr = INT_VAL(INT(v));
+            if (i > 0) {
+                result = result && prev > curr;
+            }
+            prev = INT_VAL(INT(v));
+        }
+    }
+    return VAL(bool_from_int(result));
 }
 
 Env *primitive_bindings(void)
@@ -198,16 +260,37 @@ 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("car", _car, 1);
-    DEFINE("pair?", prim_pairP, 1);
+    DEFINE("cdr", _cdr, 1);
-    DEFINE("not", prim_not, 1);
+    DEFINE("cons", _cons, 2);
-    DEFINE("+", prim_add, ARITY_VARARGS);
+    DEFINE("null?", _nullP, 1);
-    DEFINE("-", prim_sub, ARITY_VARARGS);
+    DEFINE("pair?", _pairP, 1);
-    DEFINE("*", prim_mul, ARITY_VARARGS);
+    DEFINE("is?", _isP, 2);
-    DEFINE("/", prim_div, ARITY_VARARGS);
+    DEFINE("equal?", _equalP, 2);
-    DEFINE("=", prim_int_eq, ARITY_VARARGS);
+    DEFINE("not", _not, 1);
-    DEFINE("car", prim_car, 1);
+    DEFINE("+", _add, ARITY_VARARGS);
-    DEFINE("cdr", prim_cdr, 1);
+    DEFINE("-", _sub, ARITY_VARARGS);
-    DEFINE("cons", prim_cons, 2);
+    DEFINE("*", _mul, ARITY_VARARGS);
+    DEFINE("/", _div, ARITY_VARARGS);
+    DEFINE("=", _int_eq, ARITY_VARARGS);
+    DEFINE("<", _int_lt, ARITY_VARARGS);
+    DEFINE(">", _int_gt, ARITY_VARARGS);
+
+    /* symbol? */
+    /* list? */
+    /* dotted-list? */
+    /* number? */
+    /* integer? */
+    /* string? */
+    /* bool? */
+    /* function? */
+    /* primitive? */
+
+    /* string=? */
+    /* string< */
+    /* string> */
+    /* string-concatenate */
+    /* string-slice */
+    
     return env;
 }

src/primitive.h

@@ -13,7 +13,7 @@
 #include "env.h"
 #include "lake.h"
 
-LakePrimitive *prim_make(char *name, int arity, lake_fn fn);
+LakePrimitive *prim_make(char *name, int arity, lake_prim fn);
 char *prim_repr(LakePrimitive *prim);
 Env *primitive_bindings(void);
 

src/string.c

@@ -67,9 +67,11 @@ LakeInt *str_cmp(LakeStr *a, LakeStr *b)
     return int_from_c(g_strcmp0(a->s, b->s));
 }
 
-LakeBool *str_eq(LakeStr *a, LakeStr *b)
+gboolean str_equal(LakeStr *a, LakeStr *b)
 {
-    return bool_from_int(g_strcmp0(a->s, b->s) == 0);
+    size_t n = STR_N(a);
+    if (n != STR_N(b)) return FALSE;
+    return g_strcmp0(a->s, b->s) == 0;
 }
 
 LakeStr *str_to_str(LakeStr *str)

src/string.h

@@ -10,6 +10,7 @@
 #ifndef _LAKE_STRING_H
 #define _LAKE_STRING_H 1
 
+#include <glib.h>
 #include "lake.h"
 
 LakeStr *str_make(void);
@@ -20,7 +21,7 @@ char *str_val(LakeStr *str);
 LakeInt *str_len(LakeStr *str);
 LakeVal *str_set(LakeStr *str, char *s);
 LakeInt *str_cmp(LakeStr *a, LakeStr *b);
-LakeBool *str_eq(LakeStr *a, LakeStr *b);
+gboolean str_equal(LakeStr *a, LakeStr *b);
 LakeStr *str_to_str(LakeStr *str);
 
 #endif

src/sym.c

@@ -59,8 +59,3 @@ unsigned long sym_val(LakeSym *sym)
 {
     return sym->hash;
 }
-
-LakeBool *sym_eq(LakeSym *a, LakeSym *b)
-{
-    return bool_from_int(g_strcmp0(a->s, b->s) == 0);
-}

src/sym.h

@@ -17,6 +17,5 @@ LakeStr *sym_to_str(LakeSym *sym);
 LakeSym *sym_from_str(LakeStr *str);
 char *sym_repr(LakeSym *sym);
 unsigned long sym_val(LakeSym *sym);
-LakeBool *sym_eq(LakeSym *a, LakeSym *b);
 
 #endif

src/symtable.c

@@ -18,7 +18,7 @@ static guint _sym_hash(gconstpointer key)
 
 static gboolean _sym_eq(gconstpointer a, gconstpointer b)
 {
-    return BOOL_VAL(sym_eq(SYM(a), SYM(b)));
+    return a == b;
 }
 
 GHashTable *symtable_make(void)