sjs/lake
1
0
Fork 0
mirror of https://github.com/samsonjs/lake.git synced 2026-03-25 08:55:49 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

add real bools, remove macros, print circular lists

Browse source
This commit is contained in:
Sami Samhuri 2011-06-11 02:11:49 -07:00
parent 7d58b8ed7e
commit 792fcd879f
30 changed files with 325 additions and 155 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
src/Makefile
View file

@ -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 \

58
src/bool.c Normal file
View file

@ -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;
}

26
src/bool.h Normal file
View file

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

3
src/comment.c
View file

@ -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));
}

4
src/comment.h
View file

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

23
src/common.h Normal file
View file

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

22
src/dlist.c
View file

@ -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 *tailA = DLIST_TAIL(a);
LakeVal *headB = VAL(DLIST_HEAD(b));
LakeVal *tailB = DLIST_TAIL(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);
}

6
src/dlist.h
View file

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

1
src/env.c
View file

@ -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"

1
src/env.h
View file

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

104
src/eval.c
View file

@ -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) {
result = BOOL_AND(ctx, result, eval(ctx, env, list_shift(expr)));
while (lk_is_truthy(ctx, result) && LIST_N(expr) > 0) {
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) {
result = BOOL_OR(ctx, result, eval(ctx, env, list_shift(expr)));
while (lk_is_falsy(ctx, result) && LIST_N(expr) > 0) {
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);
LakeSym *varargs = SYM(DLIST_TAIL(def));
LakeList *params = dlist_head(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);
LakeSym *varargs = SYM(DLIST_TAIL(def));
LakeList *params = dlist_head(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, \
sym_intern(ctx, name), \
(gpointer)fn)
/* HANDLER("load", &load_special_form); */
HANDLER("quote", &_quote);
HANDLER("and", &_and);
HANDLER("or", &_or);
HANDLER("if", &_if);
HANDLER("when", &_when);
HANDLER("cond", &_cond);
HANDLER("set!", &_setB);
HANDLER("define", &_define);
HANDLER("lambda", &_lambda);
/* HANDLER("let", &_let); */
/* HANDLER("let!", &_letB); */
/* HANDLER("letrec", &_letrec); */
#undef HANDLER
/* define_handler(ctx, "load", &load_special_form); */
define_handler(ctx, "quote", &_quote);
define_handler(ctx, "and", &_and);
define_handler(ctx, "or", &_or);
define_handler(ctx, "if", &_if);
define_handler(ctx, "when", &_when);
define_handler(ctx, "cond", &_cond);
define_handler(ctx, "set!", &_setB);
define_handler(ctx, "define", &_define);
define_handler(ctx, "lambda", &_lambda);
/* define_handler(ctx, "let", &_let); */
/* define_handler(ctx, "let!", &_letB); */
/* define_handler(ctx, "letrec", &_letrec); */
}
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 */

5
src/eval.h
View file

@ -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
#endif

5
src/fn.c
View file

@ -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);
}

1
src/int.c
View file

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

57
src/lake.c
View file

@ -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);
s = g_strdup("");
// If it wasn't a LakeVal we already crashed at the beginning of the switch,
// 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;

34
src/lake.h
View file

@ -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);
gboolean lake_equal(LakeVal *a, LakeVal *b);
char *lake_repr(LakeVal *val);
int lk_val_size(void *x);
int lk_is_type(LakeType t, void *x);
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>

14
src/list.c
View file

@ -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, " ");

3
src/list.h
View file

@ -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);

17
src/parse.c
View file

@ -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);
}

41
src/primitive.c
View file

@ -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)

1
src/repl.c
View file

@ -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"

3
src/str.c
View file

@ -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;

3
src/str.h
View file

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

1
src/sym.c
View file

@ -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"

5
src/symtable.c
View file

@ -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;
}

1
src/symtable.h
View file

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

10
test/test_comment.c
View file

@ -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("value size is incorrect", VAL_SIZE(comment) == sizeof(LakeComment));
lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment));
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("value size is incorrect", VAL_SIZE(comment) == sizeof(LakeComment));
lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment));
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);

11
test/test_dlist.c
View file

@ -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("value size is incorrect", VAL_SIZE(dlist) == sizeof(LakeDottedList));
lt_assert("type is not TYPE_DLIST", lk_is_type(TYPE_DLIST, dlist));
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))));
lt_assert("tail value is incorrect", lake_equal(tail, DLIST_TAIL(dlist)));
lake_equal(VAL(head), VAL(dlist_head(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;

1
test/test_env.c
View file

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

18
test/test_lake.c
View file

@ -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("F is not a boolean", IS(TYPE_BOOL, lake->F));
lt_assert("value of T is zero", BOOL_VAL(lake->T));
lt_assert("value of F is non-zero", !BOOL_VAL(lake->F));
lt_assert("T is not a boolean", lk_is_type(TYPE_BOOL, lake->T));
lt_assert("F is not a boolean", lk_is_type(TYPE_BOOL, lake->F));
lt_assert("value of T is zero", lk_bool_val(lake->T));
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);