add real bools, remove macros, print circular lists

src/Makefile

@@ -3,6 +3,7 @@ CC = gcc
 CFLAGS := -Wall -g $(shell pkg-config --cflags glib-2.0)
 LFLAGS := $(shell pkg-config --libs glib-2.0)
 LAKE_OBJS = $(LAKE_BUILD)/comment.o   \
+            $(LAKE_BUILD)/bool.o      \
             $(LAKE_BUILD)/dlist.o     \
             $(LAKE_BUILD)/env.o       \
             $(LAKE_BUILD)/eval.o      \

src/bool.c

@@ -0,0 +1,58 @@
+/** 
+  * bool.c
+  * Lake Scheme
+  *
+  * Copyright 2011 Sami Samhuri
+  * MIT License
+  *
+  */
+
+#include <glib.h>
+#include "bool.h"
+#include "common.h"
+#include "lake.h"
+
+bool lk_bool_val(LakeBool *b)
+{
+    return b->val;
+}
+
+bool lk_is_true(LakeCtx *ctx, LakeVal *x)
+{
+    return VAL(x) == VAL(ctx->T);
+}
+
+bool lk_is_false(LakeCtx *ctx, LakeVal *x)
+{
+    return VAL(x) == VAL(ctx->F);
+}
+
+bool lk_is_truthy(LakeCtx *ctx, LakeVal *x)
+{
+    return !lk_is_false(ctx, x);
+}
+
+bool lk_is_falsy(LakeCtx *ctx, LakeVal *x)
+{
+    return lk_is_false(ctx, x);
+}
+
+LakeBool *lk_bool_from_int(LakeCtx *ctx, int n)
+{
+    return n ? ctx->T : ctx->F;
+}
+
+char *lk_bool_repr(LakeBool *b)
+{
+    return g_strdup(lk_bool_val(b) ? "#t" : "#f");
+}
+
+LakeVal *lk_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y)
+{
+    return lk_is_truthy(ctx, x) && lk_is_truthy(ctx, y) ? y : x;
+}
+
+LakeVal *lk_bool_or(LakeCtx *ctx, LakeVal *x, LakeVal *y)
+{
+    return lk_is_truthy(ctx, x) ? x : y;
+}

src/bool.h

@@ -0,0 +1,26 @@
+/** 
+  * bool.h
+  * Lake Scheme
+  *
+  * Copyright 2011 Sami Samhuri
+  * MIT License
+  *
+  */
+
+#ifndef _LAKE_BOOL_H
+#define _LAKE_BOOL_H 1
+
+#include "common.h"
+#include "lake.h"
+
+bool lk_bool_val(LakeBool *b);
+bool lk_is_true(LakeCtx *ctx, LakeVal *x);
+bool lk_is_false(LakeCtx *ctx, LakeVal *x);
+bool lk_is_truthy(LakeCtx *ctx, LakeVal *x);
+bool lk_is_falsy(LakeCtx *ctx, LakeVal *x);
+LakeBool *lk_bool_from_int(LakeCtx *ctx, int n);
+char *lk_bool_repr(LakeBool *b);
+LakeVal *lk_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y);
+LakeVal *lk_bool_or(LakeCtx *ctx, LakeVal *x, LakeVal *y);
+
+#endif

src/comment.c

@@ -8,6 +8,7 @@
   */
 
 #include <glib.h>
+#include "common.h"
 #include "comment.h"
 #include "lake.h"
 #include "str.h"
@@ -37,7 +38,7 @@ char *comment_repr(LakeComment *comment)
 	return g_strdup(STR_S(comment->text));
 }
 
-gboolean comment_equal(LakeComment *a, LakeComment *b)
+bool comment_equal(LakeComment *a, LakeComment *b)
 {
     return str_equal(COMM_TEXT(a), COMM_TEXT(b));
 }

src/comment.h

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

src/common.h

@@ -0,0 +1,23 @@
+/** 
+  * common.h
+  * Lake Scheme
+  *
+  * Copyright 2011 Sami Samhuri
+  * MIT License
+  *
+  */
+
+#ifndef _LAKE_COMMON_H
+#define _LAKE_COMMON_H 1
+
+typedef int bool;
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+#endif

src/dlist.c

@@ -26,6 +26,16 @@ LakeDottedList *dlist_make(LakeList *head, LakeVal *tail)
 	return dlist;
 }
 
+LakeList *dlist_head(LakeDottedList *dlist)
+{
+    return dlist->head;
+}
+
+LakeVal *dlist_tail(LakeDottedList *dlist)
+{
+    return dlist->tail;
+}
+
 char *dlist_repr(LakeDottedList *dlist)
 {
 	GString *s = g_string_new("(");
@@ -40,7 +50,7 @@ char *dlist_repr(LakeDottedList *dlist)
         }
     }
     else if (dlist->head) {
-        s2 = lake_repr(VAL(dlist->head));
+        s2 = lake_repr(dlist->head);
         g_string_append(s, s2);
         g_free(s2);
     }
@@ -54,11 +64,11 @@ char *dlist_repr(LakeDottedList *dlist)
 	return repr;
 }
 
-gboolean dlist_equal(LakeDottedList *a, LakeDottedList *b)
+bool dlist_equal(LakeDottedList *a, LakeDottedList *b)
 {
-    LakeVal *headA = VAL(DLIST_HEAD(a));
+    LakeVal *headA = VAL(dlist_head(a));
-    LakeVal *tailA = DLIST_TAIL(a);
+    LakeVal *tailA = dlist_tail(a);
-    LakeVal *headB = VAL(DLIST_HEAD(b));
+    LakeVal *headB = VAL(dlist_head(b));
-    LakeVal *tailB = DLIST_TAIL(b);
+    LakeVal *tailB = dlist_tail(b);
     return lake_equal(headA, headB) && lake_equal(tailA, tailB);
 }

src/dlist.h

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

src/env.c

@@ -10,6 +10,7 @@
 #include <glib.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include "common.h"
 #include "lake.h"
 #include "env.h"
 #include "symtable.h"

src/env.h

@@ -11,6 +11,7 @@
 #define _LAKE_ENV_H 1
 
 #include <glib.h>
+#include "common.h"
 
 struct env {
     struct env *parent;

src/eval.c

@@ -10,16 +10,20 @@
 #include <glib.h>
 #include <stdlib.h>
 #include <stdio.h>
+#include <string.h>
+#include "bool.h"
+#include "common.h"
 #include "env.h"
 #include "eval.h"
 #include "fn.h"
 #include "lake.h"
+#include "parse.h"
 
 typedef LakeVal *(*special_form_handler)(LakeCtx *ctx, Env *env, LakeList *expr);
 
 static void invalid_special_form(LakeList *expr, char *detail)
 {
-    ERR("malformed special form, %s: %s", detail, lake_repr(VAL(expr)));
+    ERR("malformed special form, %s: %s", detail, lake_repr(expr));
 }
 
 /* expr begins with the symbol "quote" so the quoted value is the 2nd value */
@@ -39,8 +43,8 @@ static LakeVal *_and(LakeCtx *ctx, Env *env, LakeList *expr)
     
     /* (and ...) */
     LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->T);
-    while (IS_TRUTHY(ctx, result) && LIST_N(expr) > 0) {
+    while (lk_is_truthy(ctx, result) && LIST_N(expr) > 0) {
-        result = BOOL_AND(ctx, result, eval(ctx, env, list_shift(expr)));
+        result = lk_bool_and(ctx, result, eval(ctx, env, list_shift(expr)));
     }
     return result;
 }
@@ -52,8 +56,8 @@ static LakeVal *_or(LakeCtx *ctx, Env *env, LakeList *expr)
     
     /* (or ...) */
     LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->F);
-    while (IS_FALSY(ctx, result) && LIST_N(expr) > 0) {
+    while (lk_is_falsy(ctx, result) && LIST_N(expr) > 0) {
-        result = BOOL_OR(ctx, result, eval(ctx, env, list_shift(expr)));
+        result = lk_bool_or(ctx, result, eval(ctx, env, list_shift(expr)));
     }
     return result;
 }
@@ -61,12 +65,12 @@ static LakeVal *_or(LakeCtx *ctx, Env *env, LakeList *expr)
 static LakeVal *_setB(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     /* (set! x 42) */
-    if (LIST_N(expr) == 3 && IS(TYPE_SYM, LIST_VAL(expr, 1))) {
+    if (LIST_N(expr) == 3 && lk_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
         list_shift(expr); /* drop the "set!" symbol */
         LakeSym *var = SYM(list_shift(expr));
         LakeVal *form = list_shift(expr);
         if (!env_set(env, var, form)) {
-            ERR("%s is not defined", SYM_S(var));
+            ERR("%s is not defined", sym_repr(var));
         }
     }
     else {
@@ -80,7 +84,7 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
     /* TODO: make these more robust, check all expected params */
     
     /* (define x 42) */
-    if (LIST_N(expr) == 3 && IS(TYPE_SYM, LIST_VAL(expr, 1))) {
+    if (LIST_N(expr) == 3 && lk_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
         list_shift(expr); /* drop the "define" symbol */
         LakeSym *var = SYM(list_shift(expr));
         LakeVal *form = list_shift(expr);
@@ -88,7 +92,7 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
     }
     
     /* (define (inc x) (+ 1 x)) */
-    else if (LIST_N(expr) >= 3 && IS(TYPE_LIST, LIST_VAL(expr, 1))) {
+    else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_LIST, LIST_VAL(expr, 1))) {
         list_shift(expr); /* drop the "define" symbol */
         LakeList *params = LIST(list_shift(expr));
         LakeSym *var = SYM(list_shift(params));
@@ -97,11 +101,11 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
     }
     
     /* (define (print format . args) (...)) */
-    else if (LIST_N(expr) >= 3 && IS(TYPE_DLIST, LIST_VAL(expr, 1))) {
+    else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_DLIST, LIST_VAL(expr, 1))) {
         list_shift(expr); /* drop the "define" symbol */
         LakeDottedList *def = DLIST(list_shift(expr));
-        LakeList *params = DLIST_HEAD(def);
+        LakeList *params = dlist_head(def);
-        LakeSym *varargs = SYM(DLIST_TAIL(def));
+        LakeSym *varargs = SYM(dlist_tail(def));
         LakeSym *var = SYM(list_shift(params));
         LakeList *body = expr;
         env_define(env, var, VAL(fn_make(params, varargs, body, env)));
@@ -117,21 +121,21 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
 static LakeVal *_lambda(LakeCtx *ctx, Env *env, LakeList *expr)
 {
     /* (lambda (a b c) ...) */
-    if (LIST_N(expr) >= 3 && IS(TYPE_LIST, LIST_VAL(expr, 1))) {
+    if (LIST_N(expr) >= 3 && lk_is_type(TYPE_LIST, LIST_VAL(expr, 1))) {
         list_shift(expr); /* drop the "lambda" symbol */
         LakeList *params = LIST(list_shift(expr));
         LakeList *body = expr;
         return VAL(fn_make(params, NULL, body, env));
     }
-    else if (LIST_N(expr) >= 3 && IS(TYPE_DLIST, LIST_VAL(expr, 1))) {
+    else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_DLIST, LIST_VAL(expr, 1))) {
         list_shift(expr); /* drop the "lambda" symbol */
         LakeDottedList *def = DLIST(list_shift(expr));
-        LakeList *params = DLIST_HEAD(def);
+        LakeList *params = dlist_head(def);
-        LakeSym *varargs = SYM(DLIST_TAIL(def));
+        LakeSym *varargs = SYM(dlist_tail(def));
         LakeList *body = expr;
         return VAL(fn_make(params, varargs, body, env));
     }
-    else if (LIST_N(expr) >= 3 && IS(TYPE_SYM, LIST_VAL(expr, 1))) {
+    else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
         list_shift(expr); /* drop the "lambda" symbol */
         LakeSym *varargs = SYM(list_shift(expr));
         LakeList *body = expr;
@@ -151,7 +155,7 @@ static LakeVal *_if(LakeCtx *ctx, Env *env, LakeList *expr)
     }
     list_shift(expr); /* "if" token */
     LakeVal *cond = eval(ctx, env, list_shift(expr));
-    if (IS_TRUTHY(ctx, cond)) {
+    if (lk_is_truthy(ctx, cond)) {
         return eval(ctx, env, list_shift(expr));
     }
     else {
@@ -168,13 +172,13 @@ static LakeVal *_cond(LakeCtx *ctx, Env *env, LakeList *expr)
     LakeVal *pred;
     LakeList *conseq;
     while (LIST_N(expr)) {
-        if (!IS(TYPE_LIST, LIST_VAL(expr, 0))) {
+        if (!lk_is_type(TYPE_LIST, LIST_VAL(expr, 0))) {
             invalid_special_form(expr, "expected a (predicate consequence) pair");
             return NULL;
         }
         conseq = LIST(list_shift(expr));
         pred = list_shift(conseq);
-        if (pred == ELSE || IS_TRUTHY(ctx, eval(ctx, env, pred))) {
+        if (pred == ELSE || lk_is_truthy(ctx, eval(ctx, env, pred))) {
             return eval_exprs1(ctx, env, conseq);
         }
     }
@@ -189,36 +193,37 @@ static LakeVal *_when(LakeCtx *ctx, Env *env, LakeList *expr)
     }
     list_shift(expr); /* "when" token */
     LakeVal *cond = eval(ctx, env, list_shift(expr));
-    return IS_TRUTHY(ctx, cond) ? eval_exprs1(ctx, env, expr) : NULL;
+    return lk_is_truthy(ctx, cond) ? eval_exprs1(ctx, env, expr) : NULL;
+}
+
+typedef LakeVal *(*handler)(LakeCtx *, Env *, LakeList *);
+
+static void define_handler(LakeCtx *ctx, char *name, handler fn)
+{
+    g_hash_table_insert(ctx->special_form_handlers, sym_intern(ctx, name), (void *)fn);
 }
 
 void init_special_form_handlers(LakeCtx *ctx)
 {
-    #define HANDLER(name, fn) g_hash_table_insert(ctx->special_form_handlers, \
+    /* define_handler(ctx, "load", &load_special_form); */
-                                                  sym_intern(ctx, name),      \
+    define_handler(ctx, "quote", &_quote);
-                                                  (gpointer)fn)
+    define_handler(ctx, "and", &_and);
-
+    define_handler(ctx, "or", &_or);
-    /* HANDLER("load", &load_special_form); */
+    define_handler(ctx, "if", &_if);
-    HANDLER("quote", &_quote);
+    define_handler(ctx, "when", &_when);
-    HANDLER("and", &_and);
+    define_handler(ctx, "cond", &_cond);
-    HANDLER("or", &_or);
+    define_handler(ctx, "set!", &_setB);
-    HANDLER("if", &_if);
+    define_handler(ctx, "define", &_define);
-    HANDLER("when", &_when);
+    define_handler(ctx, "lambda", &_lambda);
-    HANDLER("cond", &_cond);
+    /* define_handler(ctx, "let", &_let); */
-    HANDLER("set!", &_setB);
+    /* define_handler(ctx, "let!", &_letB); */
-    HANDLER("define", &_define);
+    /* define_handler(ctx, "letrec", &_letrec); */
-    HANDLER("lambda", &_lambda);
-    /* HANDLER("let", &_let); */
-    /* HANDLER("let!", &_letB); */
-    /* HANDLER("letrec", &_letrec); */
-
-    #undef HANDLER
 }
 
-gboolean is_special_form(LakeCtx *ctx, LakeList *expr)
+bool is_special_form(LakeCtx *ctx, LakeList *expr)
 {
     LakeVal *head = LIST_VAL(expr, 0);
-    if (!IS(TYPE_SYM, head)) return FALSE;
+    if (!lk_is_type(TYPE_SYM, head)) return FALSE;
     GList *special_form_names = g_hash_table_get_keys(ctx->special_form_handlers);
     return !!g_list_find(special_form_names, SYM(head));
 }
@@ -235,10 +240,15 @@ static LakeVal *eval_special_form(LakeCtx *ctx, Env *env, LakeList *expr)
     if (handler) {
         return handler(ctx, env, list_copy(expr));
     }
-    ERR("unrecognized special form: %s", SYM_S(name));
+    ERR("unrecognized special form: %s", sym_repr(name));
     return NULL;
 }
 
+LakeVal *eval_str(LakeCtx *ctx, Env *env, char *s)
+{
+    return eval(ctx, env, parse_expr(ctx, s, strlen(s)));
+}
+
 LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr)
 {
     LakeVal *result;
@@ -254,9 +264,9 @@ LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr)
         break;
 
     case TYPE_SYM:
-        result = env_get(env, (gpointer)SYM(expr));
+        result = env_get(env, (void *)SYM(expr));
         if (!result) {
-            ERR("undefined variable: %s", SYM_S(SYM(expr)));
+            ERR("undefined variable: %s", sym_repr(SYM(expr)));
         }
         break;
 
@@ -332,7 +342,7 @@ LakeVal *eval_exprs1(LakeCtx *ctx, Env *env, LakeList *exprs)
 LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args)
 {
     LakeVal *result = NULL;
-    if (IS(TYPE_PRIM, fnVal)) {
+    if (lk_is_type(TYPE_PRIM, fnVal)) {
         LakePrimitive *prim = PRIM(fnVal);
         int arity = prim->arity;
         if (arity == ARITY_VARARGS || LIST_N(args) == arity) {
@@ -343,7 +353,7 @@ LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args)
             result = NULL;
         }
     }
-    else if (IS(TYPE_FN, fnVal)) {
+    else if (lk_is_type(TYPE_FN, fnVal)) {
         LakeFn *fn = FN(fnVal);
         
         /* Check # of params */

src/eval.h

@@ -13,11 +13,12 @@
 #include "env.h"
 #include "lake.h"
 
+LakeVal *eval_str(LakeCtx *ctx, Env *env, char *s);
 LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr);
 LakeList *eval_exprs(LakeCtx *ctx, Env *env, LakeList *exprs);
 LakeVal *eval_exprs1(LakeCtx *ctx, Env *env, LakeList *exprs);
 LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args);
-gboolean is_special_form(LakeCtx *ctx, LakeList *expr);
+bool is_special_form(LakeCtx *ctx, LakeList *expr);
 void init_special_form_handlers(LakeCtx *ctx);
 
 #endif

src/fn.c

@@ -9,6 +9,7 @@
 
 #include <glib.h>
 #include <stdlib.h>
+#include "common.h"
 #include "env.h"
 #include "fn.h"
 #include "lake.h"
@@ -42,12 +43,12 @@ char *fn_repr(LakeFn *fn)
         free(s2);
 	}
 	else if (fn->varargs) {
-        s2 = lake_repr(VAL(fn->varargs));
+        s2 = lake_repr(fn->varargs);
         g_string_append(s, s2);
         free(s2);
     }
     else {
-        s2 = lake_repr(VAL(fn->params));
+        s2 = lake_repr(fn->params);
         g_string_append(s, s2);
         free(s2);
 	}

src/int.c

@@ -8,6 +8,7 @@
   */
 
 #include <glib.h>
+#include "common.h"
 #include "int.h"
 #include "lake.h"
 #include "str.h"

src/lake.c

@@ -11,7 +11,9 @@
   */
 
 #include <glib.h>
+#include "bool.h"
 #include "comment.h"
+#include "common.h"
 #include "env.h"
 #include "eval.h"
 #include "lake.h"
@@ -20,64 +22,83 @@
 #include "str.h"
 #include "symtable.h"
 
-char *lake_repr(LakeVal *expr)
+int lk_val_size(void *x)
+{
+    return VAL(x)->size;
+}
+
+int lk_is_type(LakeType t, void *x)
+{
+    return VAL(x)->type == t;
+}
+
+char *lake_repr(void *expr)
 {
     if (expr == NULL) return g_strdup("(null)");
 
     char *s = NULL;
     
-    switch (expr->type) {
+    LakeVal *e = VAL(expr);
+    switch (e->type) {
 
     case TYPE_SYM:
-        s = sym_repr(SYM(expr));
+        s = sym_repr(SYM(e));
         break;
 
     case TYPE_BOOL:
-        s = BOOL_REPR(BOOL(expr));
+        s = lk_bool_repr(BOOL(e));
         break;
 
     case TYPE_INT:
-        s = int_repr(INT(expr));
+        s = int_repr(INT(e));
         break;
 
     case TYPE_STR:
-        s = g_strdup_printf("\"%s\"", STR_S(STR(expr)));
+        s = g_strdup_printf("\"%s\"", STR_S(STR(e)));
         break;
 
     case TYPE_LIST:
-		s = list_repr(LIST(expr));
+		s = list_repr(LIST(e));
         break;
     
     case TYPE_DLIST:
-        s = dlist_repr(DLIST(expr));
+        s = dlist_repr(DLIST(e));
         break;
     
     case TYPE_PRIM:
-        s = prim_repr(PRIM(expr));
+        s = prim_repr(PRIM(e));
         break;
     
     case TYPE_FN:
-        s = fn_repr(FN(expr));
+        s = fn_repr(FN(e));
         break;
     
     case TYPE_COMM:
-        s = comment_repr(COMM(expr));
+        s = comment_repr(COMM(e));
         break;
     
     default:
-        fprintf(stderr, "error: unrecognized value, type %d, size %zu bytes", expr->type, expr->size);
+        // If it wasn't a LakeVal we already crashed at the beginning of the switch,
-        s = g_strdup("");
+        // so go ahead and print out the size too.
+        fprintf(stderr, "error: unrecognized value, type %d, size %zu bytes",
+                e->type, e->size);
+        s = g_strdup("(unknown)");
     }
     
     return s;
 }
 
-gboolean lake_is(LakeVal *a, LakeVal *b)
+bool lk_is_nil(LakeVal *x)
 {
-    if (IS(TYPE_INT, a) && IS(TYPE_INT, b)) {
+    return lk_is_type(TYPE_LIST, x) && LIST_N(LIST(x)) == 0;
+}
+
+bool lake_is(LakeVal *a, LakeVal *b)
+{
+    if (lk_is_type(TYPE_INT, a) && lk_is_type(TYPE_INT, b)) {
         return INT_VAL(INT(a)) == INT_VAL(INT(b));
     }
-    if (IS_NIL(a) && IS_NIL(b)) return TRUE;
+    if (lk_is_nil(a) && lk_is_nil(b)) return TRUE;
     return a == b;
 }
 
@@ -91,7 +112,7 @@ static char *type_name(LakeVal *expr)
     return t >= 0 && t <= 8 ? type_names[t] : "(not a LakeVal)";
 }
 
-gboolean lake_equal(LakeVal *a, LakeVal *b)
+bool lake_equal(LakeVal *a, LakeVal *b)
 {
     if (a->type != b->type) return FALSE;
     switch (a->type) {
@@ -124,7 +145,7 @@ gboolean lake_equal(LakeVal *a, LakeVal *b)
     }
 }
 
-static LakeBool *bool_make(gboolean val)
+static LakeBool *bool_make(bool val)
 {
     LakeBool *b = g_malloc(sizeof(LakeBool));
     VAL(b)->type = TYPE_BOOL;

src/lake.h

@@ -12,6 +12,7 @@
 
 #include <glib.h>
 #include <stdlib.h>
+#include "common.h"
 
 #define LAKE_VERSION "0.1"
 
@@ -44,10 +45,6 @@ struct lake_val {
 };
 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;
     size_t n;
@@ -56,25 +53,12 @@ struct lake_sym {
 };
 typedef struct lake_sym LakeSym;
 
-#define SYM_S(x) (x->s)
-#define SYM_HASH(x) (x->hash)
-
 struct lake_bool {
 	LakeVal base;
-	gboolean val;
+	bool val;
 };
 typedef struct lake_bool LakeBool;
 
-#define BOOL_VAL(x) (x->val)
-#define IS_TRUE(ctx, x) (VAL(x) == VAL(ctx->T))
-#define IS_FALSE(ctx, x) (VAL(x) == VAL(ctx->F))
-#define IS_TRUTHY(ctx, x) (!IS_FALSE(ctx, x))
-#define IS_FALSY(ctx, x) (IS_FALSE(ctx, x))
-#define BOOL_FROM_INT(ctx, n) (n ? ctx->T : ctx->F)
-#define BOOL_REPR(b) (g_strdup(BOOL_VAL(b) ? "#t" : "#f"))
-#define BOOL_AND(ctx, a, b) (IS_TRUTHY(ctx, a) && IS_TRUTHY(ctx, b) ? b : a)
-#define BOOL_OR(ctx, a, b) (IS_TRUTHY(ctx, a) ? a : b)
-
 struct lake_int {
     LakeVal base;
     int val;
@@ -112,9 +96,6 @@ struct lake_dlist {
 };
 typedef struct lake_dlist LakeDottedList;
 
-#define DLIST_HEAD(x) (x->head)
-#define DLIST_TAIL(x) (x->tail)
-
 #include "env.h"
 
 /* Execution context */
@@ -150,7 +131,7 @@ struct lake_fn {
 };
 typedef struct lake_fn LakeFn;
 
-#define CALLABLE(x) (IS(TYPE_FN, x) || IS(TYPE_PRIM, x))
+#define CALLABLE(x) (lk_is_type(TYPE_FN, x) || lk_is_type(TYPE_PRIM, x))
 
 struct lake_comment {
     LakeVal base;
@@ -161,9 +142,12 @@ typedef struct lake_comment LakeComment;
 #define COMM_TEXT(x) (x->text)
 
 LakeCtx *lake_init(void);
-gboolean lake_is(LakeVal *a, LakeVal *b);
+int lk_val_size(void *x);
-gboolean lake_equal(LakeVal *a, LakeVal *b);
+int lk_is_type(LakeType t, void *x);
-char *lake_repr(LakeVal *val);
+bool lk_is_nil(LakeVal *x);
+bool lake_is(LakeVal *a, LakeVal *b);
+bool lake_equal(LakeVal *a, LakeVal *b);
+char *lake_repr(void *val);
 
 #include <stdio.h>
 

src/list.c

@@ -11,6 +11,7 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
+#include "common.h"
 #include "int.h"
 #include "lake.h"
 #include "list.h"
@@ -46,7 +47,7 @@ LakeList *list_make(void)
 LakeList *list_cons(LakeVal *car, LakeVal *cdr)
 {
     LakeList *list;
-    if (IS(TYPE_LIST, cdr)) {
+    if (lk_is_type(TYPE_LIST, cdr)) {
         list = LIST(cdr);
         list_unshift(list, car);
     }
@@ -161,7 +162,7 @@ LakeVal *list_pop(LakeList *list)
 	return tail;
 }
 
-gboolean list_equal(LakeList *a, LakeList *b)
+bool list_equal(LakeList *a, LakeList *b)
 {
     if (a == b) return TRUE;
     size_t n = LIST_N(a);
@@ -186,8 +187,15 @@ char *list_repr(LakeList *list)
 	GString *s = g_string_new("(");
     int i;
 	char *s2;
+    LakeVal *val;
     for (i = 0; i < LIST_N(list); ++i) {
-		s2 = lake_repr(LIST_VAL(list, i));
+        val = LIST_VAL(list, i);
+        if (val == VAL(list)) {
+            s2 = g_strdup("[Circular]");
+        }
+        else {
+		    s2 = lake_repr(val);
+	    }
 		g_string_append(s, s2);
 		g_free(s2);
 		if (i != LIST_N(list) - 1) g_string_append(s, " ");

src/list.h

@@ -12,6 +12,7 @@
 
 #include <glib.h>
 #include <stdlib.h>
+#include "common.h"
 #include "lake.h"
 #include "str.h"
 
@@ -28,7 +29,7 @@ LakeInt *list_len(LakeList *list);
 LakeVal *list_pop(LakeList *list);
 LakeVal *list_shift(LakeList *list);
 LakeVal *list_unshift(LakeList *list, LakeVal *val);
-gboolean list_equal(LakeList *a, LakeList *b);
+bool list_equal(LakeList *a, LakeList *b);
 LakeStr *list_to_str(LakeList *list);
 char *list_repr(LakeList *list);
 

src/parse.c

@@ -11,6 +11,7 @@
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
+#include "common.h"
 #include "dlist.h"
 #include "int.h"
 #include "lake.h"
@@ -128,37 +129,37 @@ static void backtrack(Ctx *ctx)
     ctx->i = ctx->mark;
 }
 
-static gboolean is_space(char c)
+static bool is_space(char c)
 {
     return strchr(" \r\n\t", c) != NULL;
 }
 
-static gboolean is_letter(char c)
+static bool is_letter(char c)
 {
     return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z');
 }
 
-static gboolean is_symbol(char c)
+static bool is_symbol(char c)
 {
     return strchr("!$%&|*+-/:<=>?@^_~#", c) != NULL;
 }
 
-static gboolean is_digit(char c)
+static bool is_digit(char c)
 {
     return c >= '0' && c <= '9';
 }
 
-static gboolean is_sym_char(char c)
+static bool is_sym_char(char c)
 {
     return is_letter(c) || is_symbol(c) || is_digit(c);
 }
 
-static gboolean is_newline(char c)
+static bool is_newline(char c)
 {
     return c == '\n' || c == '\r';
 }
 
-static char *parse_while(Ctx *ctx, gboolean (*is_valid)(char))
+static char *parse_while(Ctx *ctx, bool (*is_valid)(char))
 {
     size_t n = 8;
     size_t i = 0;
@@ -337,7 +338,7 @@ static LakeVal *parse_quoted(Ctx *ctx)
     return VAL(list);
 }
 
-static gboolean is_not_newline(char c)
+static bool is_not_newline(char c)
 {
     return !is_newline(c);
 }

src/primitive.c

@@ -9,7 +9,10 @@
 
 #include <glib.h>
 #include <stdlib.h>
+#include "bool.h"
+#include "common.h"
 #include "comment.h"
+#include "dlist.h"
 #include "env.h"
 #include "int.h"
 #include "dlist.h"
@@ -44,22 +47,28 @@ char *prim_repr(LakePrimitive *prim)
 static LakeVal *_car(LakeCtx *ctx, LakeList *args)
 {
     LakeList *list = LIST(LIST_VAL(args, 0));
-    if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
+    if (lk_is_type(TYPE_LIST, list) && LIST_N(list) > 0) {
         return LIST_VAL(list, 0);
     }
-    ERR("not a pair: %s", list_repr(list));
+    if (lk_is_type(TYPE_DLIST, list)) {
+        return VAL(dlist_head(DLIST(list)));
+    }
+    ERR("not a pair: %s", lake_repr(list));
     return NULL;
 }
 
 static LakeVal *_cdr(LakeCtx *ctx, LakeList *args)
 {
     LakeList *list = LIST(LIST_VAL(args, 0));
-    if (IS(TYPE_LIST, list) && LIST_N(list) > 0) {
+    if (lk_is_type(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));
+    if (lk_is_type(TYPE_DLIST, list)) {
+        return dlist_tail(DLIST(list));
+    }
+    ERR("not a pair: %s", lake_repr(list));
     return NULL;
 }
 
@@ -73,14 +82,14 @@ static LakeVal *_cons(LakeCtx *ctx, LakeList *args)
 static LakeVal *_nullP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *val = list_shift(args);
-    LakeBool *is_null = BOOL_FROM_INT(ctx, IS(TYPE_LIST, val) && LIST_N(LIST(val)) == 0);
+    LakeBool *is_null = lk_bool_from_int(ctx, lk_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) == 0);
     return VAL(is_null);
 }
 
 static LakeVal *_pairP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *val = list_shift(args);
-    LakeBool *is_pair = BOOL_FROM_INT(ctx, IS(TYPE_LIST, val) && LIST_N(LIST(val)) > 0);
+    LakeBool *is_pair = lk_bool_from_int(ctx, lk_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) > 0);
     return VAL(is_pair);
 }
 
@@ -88,25 +97,25 @@ static LakeVal *_isP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *a = LIST_VAL(args, 0);
     LakeVal *b = LIST_VAL(args, 1);
-    return VAL(BOOL_FROM_INT(ctx, lake_is(a, b)));
+    return VAL(lk_bool_from_int(ctx, lake_is(a, b)));
 }
 
 static LakeVal *_equalP(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *a = LIST_VAL(args, 0);
     LakeVal *b = LIST_VAL(args, 1);
-    return VAL(BOOL_FROM_INT(ctx, lake_equal(a, b)));
+    return VAL(lk_bool_from_int(ctx, lake_equal(a, b)));
 }
 
 static LakeVal *_not(LakeCtx *ctx, LakeList *args)
 {
     LakeVal *val = list_shift(args);
-    LakeBool *not = BOOL_FROM_INT(ctx, IS_FALSE(ctx, val));
+    LakeBool *not = lk_bool_from_int(ctx, lk_is_false(ctx, val));
     return VAL(not);
 }
 
 #define ENSURE_INT(x, i) do {                                           \
-        if (!IS(TYPE_INT, x)) {                                         \
+        if (!lk_is_type(TYPE_INT, x)) {                                         \
             ERR("argument %zu is not an integer: %s", i, lake_repr(x)); \
             return NULL;                                                \
         }                                                               \
@@ -197,7 +206,7 @@ static LakeVal *_div(LakeCtx *ctx, LakeList *args)
 
 static LakeVal *_int_eq(LakeCtx *ctx, LakeList *args)
 {
-    gboolean result = TRUE;
+    bool result = TRUE;
     size_t n = LIST_N(args);
     size_t i;
     int curr, prev;
@@ -210,12 +219,12 @@ static LakeVal *_int_eq(LakeCtx *ctx, LakeList *args)
         }
         prev = INT_VAL(INT(v));
     }
-    return VAL(BOOL_FROM_INT(ctx, result));
+    return VAL(lk_bool_from_int(ctx, result));
 }
 
 static LakeVal *_int_lt(LakeCtx *ctx, LakeList *args)
 {
-    gboolean result = TRUE;
+    bool result = TRUE;
     size_t n = LIST_N(args);
     size_t i;
     int curr, prev;
@@ -231,12 +240,12 @@ static LakeVal *_int_lt(LakeCtx *ctx, LakeList *args)
             prev = INT_VAL(INT(v));
         }
     }
-    return VAL(BOOL_FROM_INT(ctx, result));
+    return VAL(lk_bool_from_int(ctx, result));
 }
 
 static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args)
 {
-    gboolean result = TRUE;
+    bool result = TRUE;
     size_t n = LIST_N(args);
     size_t i;
     int curr, prev;
@@ -252,7 +261,7 @@ static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args)
             prev = INT_VAL(INT(v));
         }
     }
-    return VAL(BOOL_FROM_INT(ctx, result));
+    return VAL(lk_bool_from_int(ctx, result));
 }
 
 void bind_primitives(LakeCtx *ctx)

src/repl.c

@@ -15,6 +15,7 @@
 #include <stdio.h>
 #include <string.h>
 #include <sys/select.h>
+#include "common.h"
 #include "env.h"
 #include "eval.h"
 #include "lake.h"

src/str.c

@@ -10,6 +10,7 @@
 #include <glib.h>
 #include <stdlib.h>
 #include <string.h>
+#include "common.h"
 #include "int.h"
 #include "lake.h"
 #include "str.h"
@@ -62,7 +63,7 @@ char *str_val(LakeStr *str)
     return g_strdup(str->s);
 }
 
-gboolean str_equal(LakeStr *a, LakeStr *b)
+bool str_equal(LakeStr *a, LakeStr *b)
 {
     size_t n = STR_N(a);
     if (n != STR_N(b)) return FALSE;

src/str.h

@@ -11,6 +11,7 @@
 #define _LAKE_STRING_H 1
 
 #include <glib.h>
+#include "common.h"
 #include "lake.h"
 
 LakeStr *str_make(void);
@@ -19,7 +20,7 @@ LakeStr *str_copy(LakeStr *str);
 LakeStr *str_from_c(char *s);
 char *str_val(LakeStr *str);
 LakeInt *str_len(LakeStr *str);
-gboolean str_equal(LakeStr *a, LakeStr *b);
+bool str_equal(LakeStr *a, LakeStr *b);
 LakeStr *str_to_str(LakeStr *str);
 
 #endif

src/sym.c

@@ -11,6 +11,7 @@
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
+#include "common.h"
 #include "env.h"
 #include "lake.h"
 #include "str.h"

src/symtable.c

@@ -8,15 +8,16 @@
   */
 
 #include <glib.h>
+#include "common.h"
 #include "lake.h"
 #include "symtable.h"
 
 static guint _sym_hash(gconstpointer key)
 {
-    return SYM_HASH(SYM(key));
+    return sym_val(SYM(key));
 }
 
-static gboolean _sym_eq(gconstpointer a, gconstpointer b)
+static bool _sym_eq(gconstpointer a, gconstpointer b)
 {
     return a == b;
 }

src/symtable.h

@@ -11,6 +11,7 @@
 #define _LAKE_SYMTABLE_H 1
 
 #include <glib.h>
+#include "common.h"
 
 GHashTable *symtable_make(void);
 

test/test_comment.c

@@ -21,8 +21,8 @@ static LakeStr *text = NULL;
 static char *test_comment_make(void)
 {
     LakeComment *comment = comment_make(text);
-    lt_assert("type is not TYPE_COMM", IS(TYPE_COMM, comment));
+    lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment));
-    lt_assert("value size is incorrect", VAL_SIZE(comment) == sizeof(LakeComment));
+    lt_assert("value size is incorrect", lk_val_size(comment) == sizeof(LakeComment));
     lt_assert("comment text is incorrect", str_equal(text, COMM_TEXT(comment)));
     return 0;
 }
@@ -31,8 +31,8 @@ static char *test_comment_make(void)
 static char *test_comment_from_c(void)
 {
     LakeComment *comment = comment_from_c(TEXT);
-    lt_assert("type is not TYPE_COMM", IS(TYPE_COMM, comment));
+    lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment));
-    lt_assert("value size is incorrect", VAL_SIZE(comment) == sizeof(LakeComment));
+    lt_assert("value size is incorrect", lk_val_size(comment) == sizeof(LakeComment));
     lt_assert("comment text is incorrect", str_equal(text, COMM_TEXT(comment)));
     return 0;
 }
@@ -45,7 +45,7 @@ static char *test_comment_repr(void)
     return 0;
 }
 
-/* gboolean comment_equal(LakeComment *a, LakeComment *b) */
+/* bool comment_equal(LakeComment *a, LakeComment *b) */
 static char *test_comment_equal(void)
 {
     LakeComment *a = comment_make(text);

test/test_dlist.c

@@ -9,6 +9,7 @@
 
 #include <glib.h>
 #include <string.h>
+#include "common.h"
 #include "laketest.h"
 #include "lake.h"
 #include "list.h"
@@ -21,11 +22,11 @@ static char *REPR = "(() . ())";
 /* LakeDottedList *dlist_make(LakeList *head, LakeVal *tail) */
 static char *test_dlist_make(void)
 {
-    lt_assert("type is not TYPE_DLIST", IS(TYPE_DLIST, dlist));
+    lt_assert("type is not TYPE_DLIST", lk_is_type(TYPE_DLIST, dlist));
-    lt_assert("value size is incorrect", VAL_SIZE(dlist) == sizeof(LakeDottedList));
+    lt_assert("value size is incorrect", lk_val_size(dlist) == sizeof(LakeDottedList));
     lt_assert("head value is incorrect",
-              lake_equal(VAL(head), VAL(DLIST_HEAD(dlist))));
+              lake_equal(VAL(head), VAL(dlist_head(dlist))));
-    lt_assert("tail value is incorrect", lake_equal(tail, DLIST_TAIL(dlist)));
+    lt_assert("tail value is incorrect", lake_equal(tail, dlist_tail(dlist)));
     return 0;
 }
 
@@ -51,7 +52,7 @@ static char *test_dlist_repr(void)
     return 0;
 }
 
-/* gboolean dlist_equal(LakeDottedList *a, LakeDottedList *b) */
+/* bool dlist_equal(LakeDottedList *a, LakeDottedList *b) */
 static char *test_dlist_equal(void)
 {
     LakeDottedList *a = dlist;

test/test_env.c

@@ -8,6 +8,7 @@
   */
 
 #include <glib.h>
+#include "common.h"
 #include "laketest.h"
 #include "env.h"
 #include "lake.h"

test/test_lake.c

@@ -7,7 +7,9 @@
   *
   */
 
+#include <string.h>
 #include "laketest.h"
+#include "bool.h"
 #include "int.h"
 #include "lake.h"
 #include "str.h"
@@ -32,19 +34,19 @@ static char *test_lake_init(void)
               NULL != lake->special_form_handlers);
     lt_assert("T is null", NULL != lake->T);
     lt_assert("F is null", NULL != lake->F);
-    lt_assert("T is not a boolean", IS(TYPE_BOOL, lake->T));
+    lt_assert("T is not a boolean", lk_is_type(TYPE_BOOL, lake->T));
-    lt_assert("F is not a boolean", IS(TYPE_BOOL, lake->F));
+    lt_assert("F is not a boolean", lk_is_type(TYPE_BOOL, lake->F));
-    lt_assert("value of T is zero", BOOL_VAL(lake->T));
+    lt_assert("value of T is zero", lk_bool_val(lake->T));
-    lt_assert("value of F is non-zero", !BOOL_VAL(lake->F));
+    lt_assert("value of F is non-zero", !lk_bool_val(lake->F));
     return 0;
 }
 
-static gboolean _is(void *a, void *b)
+static bool _is(void *a, void *b)
 {
     return lake_is(VAL(a), VAL(b));
 }
 
-/* gboolean lake_is(LakeVal *a, LakeVal *b) */
+/* bool lake_is(LakeVal *a, LakeVal *b) */
 static char *test_lake_is(void)
 {
     LakeInt *i = int_from_c(42);
@@ -66,12 +68,12 @@ static char *test_lake_is(void)
     return 0;
 }
 
-static gboolean _equal(void *a, void *b)
+static bool _equal(void *a, void *b)
 {
     return lake_equal(VAL(a), VAL(b));
 }
 
-/* gboolean lake_equal(LakeVal *a, LakeVal *b) */
+/* bool lake_equal(LakeVal *a, LakeVal *b) */
 static char *test_lake_equal(void)
 {
     LakeInt *i = int_from_c(42);