mirror of
https://github.com/samsonjs/lake.git
synced 2026-04-27 14:57:43 +00:00
s/lk_/lake_/g because the great vowel shortage of 1973 is over
This commit is contained in:
parent
6047bba195
commit
7ac38117b3
29 changed files with 361 additions and 325 deletions
28
src/bool.c
28
src/bool.c
|
|
@ -12,47 +12,47 @@
|
||||||
#include "common.h"
|
#include "common.h"
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
|
|
||||||
bool lk_bool_val(LakeBool *b)
|
bool lake_bool_val(LakeBool *b)
|
||||||
{
|
{
|
||||||
return b->val;
|
return b->val;
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lk_is_true(LakeCtx *ctx, LakeVal *x)
|
bool lake_is_true(LakeCtx *ctx, LakeVal *x)
|
||||||
{
|
{
|
||||||
return VAL(x) == VAL(ctx->T);
|
return VAL(x) == VAL(ctx->T);
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lk_is_false(LakeCtx *ctx, LakeVal *x)
|
bool lake_is_false(LakeCtx *ctx, LakeVal *x)
|
||||||
{
|
{
|
||||||
return VAL(x) == VAL(ctx->F);
|
return VAL(x) == VAL(ctx->F);
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lk_is_truthy(LakeCtx *ctx, LakeVal *x)
|
bool lake_is_truthy(LakeCtx *ctx, LakeVal *x)
|
||||||
{
|
{
|
||||||
return !lk_is_false(ctx, x);
|
return !lake_is_false(ctx, x);
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lk_is_falsy(LakeCtx *ctx, LakeVal *x)
|
bool lake_is_falsy(LakeCtx *ctx, LakeVal *x)
|
||||||
{
|
{
|
||||||
return lk_is_false(ctx, x);
|
return lake_is_false(ctx, x);
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeBool *lk_bool_from_int(LakeCtx *ctx, int n)
|
LakeBool *lake_bool_from_int(LakeCtx *ctx, int n)
|
||||||
{
|
{
|
||||||
return n ? ctx->T : ctx->F;
|
return n ? ctx->T : ctx->F;
|
||||||
}
|
}
|
||||||
|
|
||||||
char *lk_bool_repr(LakeBool *b)
|
char *lake_bool_repr(LakeBool *b)
|
||||||
{
|
{
|
||||||
return strdup(lk_bool_val(b) ? "#t" : "#f");
|
return strdup(lake_bool_val(b) ? "#t" : "#f");
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeVal *lk_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y)
|
LakeVal *lake_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y)
|
||||||
{
|
{
|
||||||
return lk_is_truthy(ctx, x) && lk_is_truthy(ctx, y) ? y : x;
|
return lake_is_truthy(ctx, x) && lake_is_truthy(ctx, y) ? y : x;
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeVal *lk_bool_or(LakeCtx *ctx, LakeVal *x, LakeVal *y)
|
LakeVal *lake_bool_or(LakeCtx *ctx, LakeVal *x, LakeVal *y)
|
||||||
{
|
{
|
||||||
return lk_is_truthy(ctx, x) ? x : y;
|
return lake_is_truthy(ctx, x) ? x : y;
|
||||||
}
|
}
|
||||||
|
|
|
||||||
18
src/bool.h
18
src/bool.h
|
|
@ -13,14 +13,14 @@
|
||||||
#include "common.h"
|
#include "common.h"
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
|
|
||||||
bool lk_bool_val(LakeBool *b);
|
bool lake_bool_val(LakeBool *b);
|
||||||
bool lk_is_true(LakeCtx *ctx, LakeVal *x);
|
bool lake_is_true(LakeCtx *ctx, LakeVal *x);
|
||||||
bool lk_is_false(LakeCtx *ctx, LakeVal *x);
|
bool lake_is_false(LakeCtx *ctx, LakeVal *x);
|
||||||
bool lk_is_truthy(LakeCtx *ctx, LakeVal *x);
|
bool lake_is_truthy(LakeCtx *ctx, LakeVal *x);
|
||||||
bool lk_is_falsy(LakeCtx *ctx, LakeVal *x);
|
bool lake_is_falsy(LakeCtx *ctx, LakeVal *x);
|
||||||
LakeBool *lk_bool_from_int(LakeCtx *ctx, int n);
|
LakeBool *lake_bool_from_int(LakeCtx *ctx, int n);
|
||||||
char *lk_bool_repr(LakeBool *b);
|
char *lake_bool_repr(LakeBool *b);
|
||||||
LakeVal *lk_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y);
|
LakeVal *lake_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y);
|
||||||
LakeVal *lk_bool_or(LakeCtx *ctx, LakeVal *x, LakeVal *y);
|
LakeVal *lake_bool_or(LakeCtx *ctx, LakeVal *x, LakeVal *y);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
|
|
@ -30,7 +30,7 @@ LakeComment *comment_make(LakeStr *text)
|
||||||
|
|
||||||
LakeComment *comment_from_c(char *text)
|
LakeComment *comment_from_c(char *text)
|
||||||
{
|
{
|
||||||
return comment_make(lk_str_from_c(text));
|
return comment_make(lake_str_from_c(text));
|
||||||
}
|
}
|
||||||
|
|
||||||
char *comment_repr(LakeComment *comment)
|
char *comment_repr(LakeComment *comment)
|
||||||
|
|
@ -40,5 +40,5 @@ char *comment_repr(LakeComment *comment)
|
||||||
|
|
||||||
bool comment_equal(LakeComment *a, LakeComment *b)
|
bool comment_equal(LakeComment *a, LakeComment *b)
|
||||||
{
|
{
|
||||||
return lk_str_equal(COMM_TEXT(a), COMM_TEXT(b));
|
return lake_str_equal(COMM_TEXT(a), COMM_TEXT(b));
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -12,7 +12,7 @@
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
char *lk_str_append(char *s1, char *s2)
|
char *lake_str_append(char *s1, char *s2)
|
||||||
{
|
{
|
||||||
size_t n2 = strlen(s2);
|
size_t n2 = strlen(s2);
|
||||||
s1 = realloc(s1, strlen(s1) + n2 + 1);
|
s1 = realloc(s1, strlen(s1) + n2 + 1);
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,6 @@ typedef int bool;
|
||||||
#define FALSE 0
|
#define FALSE 0
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
char *lk_str_append(char *s1, char *s2);
|
char *lake_str_append(char *s1, char *s2);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
12
src/dlist.c
12
src/dlist.c
|
|
@ -47,21 +47,21 @@ char *dlist_repr(LakeDottedList *dlist)
|
||||||
if (dlist->head && LIST_N(dlist->head)) {
|
if (dlist->head && LIST_N(dlist->head)) {
|
||||||
for (i = 0; i < LIST_N(dlist->head); ++i) {
|
for (i = 0; i < LIST_N(dlist->head); ++i) {
|
||||||
s2 = lake_repr(LIST_VAL(dlist->head, i));
|
s2 = lake_repr(LIST_VAL(dlist->head, i));
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
if (i != LIST_N(dlist->head) - 1) s = lk_str_append(s, " ");
|
if (i != LIST_N(dlist->head) - 1) s = lake_str_append(s, " ");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else if (dlist->head) {
|
else if (dlist->head) {
|
||||||
s2 = lake_repr(dlist->head);
|
s2 = lake_repr(dlist->head);
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
}
|
}
|
||||||
s = lk_str_append(s, " . ");
|
s = lake_str_append(s, " . ");
|
||||||
s2 = lake_repr(dlist->tail);
|
s2 = lake_repr(dlist->tail);
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
return lk_str_append(s, ")");
|
return lake_str_append(s, ")");
|
||||||
}
|
}
|
||||||
|
|
||||||
bool dlist_equal(LakeDottedList *a, LakeDottedList *b)
|
bool dlist_equal(LakeDottedList *a, LakeDottedList *b)
|
||||||
|
|
|
||||||
|
|
@ -18,19 +18,19 @@ Env *env_make(Env *parent)
|
||||||
{
|
{
|
||||||
Env *env = malloc(sizeof(Env));
|
Env *env = malloc(sizeof(Env));
|
||||||
env->parent = parent;
|
env->parent = parent;
|
||||||
env->bindings = lk_hash_make();
|
env->bindings = lake_hash_make();
|
||||||
return env;
|
return env;
|
||||||
}
|
}
|
||||||
|
|
||||||
Env *env_is_defined(Env *env, LakeSym *key)
|
Env *env_is_defined(Env *env, LakeSym *key)
|
||||||
{
|
{
|
||||||
if (lk_hash_get(env->bindings, key->s) != NULL) return env;
|
if (lake_hash_get(env->bindings, key->s) != NULL) return env;
|
||||||
return env->parent ? env_is_defined(env->parent, key) : NULL;
|
return env->parent ? env_is_defined(env->parent, key) : NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void env_put(Env *env, LakeSym *key, LakeVal *val)
|
static void env_put(Env *env, LakeSym *key, LakeVal *val)
|
||||||
{
|
{
|
||||||
lk_hash_put(env->bindings, key->s, val);
|
lake_hash_put(env->bindings, key->s, val);
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeVal *env_define(Env *env, LakeSym *key, LakeVal *val)
|
LakeVal *env_define(Env *env, LakeSym *key, LakeVal *val)
|
||||||
|
|
@ -51,7 +51,7 @@ LakeVal *env_set(Env *env, LakeSym *key, LakeVal *val)
|
||||||
|
|
||||||
LakeVal *env_get(Env *env, LakeSym *key)
|
LakeVal *env_get(Env *env, LakeSym *key)
|
||||||
{
|
{
|
||||||
LakeVal *val = lk_hash_get(env->bindings, key->s);
|
LakeVal *val = lake_hash_get(env->bindings, key->s);
|
||||||
if (!val && env->parent) {
|
if (!val && env->parent) {
|
||||||
val = env_get(env->parent, key);
|
val = env_get(env->parent, key);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,7 @@
|
||||||
|
|
||||||
struct env {
|
struct env {
|
||||||
struct env *parent;
|
struct env *parent;
|
||||||
lk_hash_t *bindings;
|
lake_hash_t *bindings;
|
||||||
};
|
};
|
||||||
typedef struct env Env;
|
typedef struct env Env;
|
||||||
|
|
||||||
|
|
|
||||||
42
src/eval.c
42
src/eval.c
|
|
@ -42,8 +42,8 @@ static LakeVal *_and(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
|
|
||||||
/* (and ...) */
|
/* (and ...) */
|
||||||
LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->T);
|
LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->T);
|
||||||
while (lk_is_truthy(ctx, result) && LIST_N(expr) > 0) {
|
while (lake_is_truthy(ctx, result) && LIST_N(expr) > 0) {
|
||||||
result = lk_bool_and(ctx, result, eval(ctx, env, list_shift(expr)));
|
result = lake_bool_and(ctx, result, eval(ctx, env, list_shift(expr)));
|
||||||
}
|
}
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
@ -55,8 +55,8 @@ static LakeVal *_or(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
|
|
||||||
/* (or ...) */
|
/* (or ...) */
|
||||||
LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->F);
|
LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->F);
|
||||||
while (lk_is_falsy(ctx, result) && LIST_N(expr) > 0) {
|
while (lake_is_falsy(ctx, result) && LIST_N(expr) > 0) {
|
||||||
result = lk_bool_or(ctx, result, eval(ctx, env, list_shift(expr)));
|
result = lake_bool_or(ctx, result, eval(ctx, env, list_shift(expr)));
|
||||||
}
|
}
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
@ -64,7 +64,7 @@ static LakeVal *_or(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
static LakeVal *_setB(LakeCtx *ctx, Env *env, LakeList *expr)
|
static LakeVal *_setB(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
{
|
{
|
||||||
/* (set! x 42) */
|
/* (set! x 42) */
|
||||||
if (LIST_N(expr) == 3 && lk_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
|
if (LIST_N(expr) == 3 && lake_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
|
||||||
list_shift(expr); /* drop the "set!" symbol */
|
list_shift(expr); /* drop the "set!" symbol */
|
||||||
LakeSym *var = SYM(list_shift(expr));
|
LakeSym *var = SYM(list_shift(expr));
|
||||||
LakeVal *form = list_shift(expr);
|
LakeVal *form = list_shift(expr);
|
||||||
|
|
@ -83,7 +83,7 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
/* TODO: make these more robust, check all expected params */
|
/* TODO: make these more robust, check all expected params */
|
||||||
|
|
||||||
/* (define x 42) */
|
/* (define x 42) */
|
||||||
if (LIST_N(expr) == 3 && lk_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
|
if (LIST_N(expr) == 3 && lake_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
|
||||||
list_shift(expr); /* drop the "define" symbol */
|
list_shift(expr); /* drop the "define" symbol */
|
||||||
LakeSym *var = SYM(list_shift(expr));
|
LakeSym *var = SYM(list_shift(expr));
|
||||||
LakeVal *form = list_shift(expr);
|
LakeVal *form = list_shift(expr);
|
||||||
|
|
@ -91,7 +91,7 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (define (inc x) (+ 1 x)) */
|
/* (define (inc x) (+ 1 x)) */
|
||||||
else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_LIST, LIST_VAL(expr, 1))) {
|
else if (LIST_N(expr) >= 3 && lake_is_type(TYPE_LIST, LIST_VAL(expr, 1))) {
|
||||||
list_shift(expr); /* drop the "define" symbol */
|
list_shift(expr); /* drop the "define" symbol */
|
||||||
LakeList *params = LIST(list_shift(expr));
|
LakeList *params = LIST(list_shift(expr));
|
||||||
LakeSym *var = SYM(list_shift(params));
|
LakeSym *var = SYM(list_shift(params));
|
||||||
|
|
@ -100,7 +100,7 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (define (print format . args) (...)) */
|
/* (define (print format . args) (...)) */
|
||||||
else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_DLIST, LIST_VAL(expr, 1))) {
|
else if (LIST_N(expr) >= 3 && lake_is_type(TYPE_DLIST, LIST_VAL(expr, 1))) {
|
||||||
list_shift(expr); /* drop the "define" symbol */
|
list_shift(expr); /* drop the "define" symbol */
|
||||||
LakeDottedList *def = DLIST(list_shift(expr));
|
LakeDottedList *def = DLIST(list_shift(expr));
|
||||||
LakeList *params = dlist_head(def);
|
LakeList *params = dlist_head(def);
|
||||||
|
|
@ -120,13 +120,13 @@ static LakeVal *_define(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
static LakeVal *_lambda(LakeCtx *ctx, Env *env, LakeList *expr)
|
static LakeVal *_lambda(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
{
|
{
|
||||||
/* (lambda (a b c) ...) */
|
/* (lambda (a b c) ...) */
|
||||||
if (LIST_N(expr) >= 3 && lk_is_type(TYPE_LIST, LIST_VAL(expr, 1))) {
|
if (LIST_N(expr) >= 3 && lake_is_type(TYPE_LIST, LIST_VAL(expr, 1))) {
|
||||||
list_shift(expr); /* drop the "lambda" symbol */
|
list_shift(expr); /* drop the "lambda" symbol */
|
||||||
LakeList *params = LIST(list_shift(expr));
|
LakeList *params = LIST(list_shift(expr));
|
||||||
LakeList *body = expr;
|
LakeList *body = expr;
|
||||||
return VAL(fn_make(params, NULL, body, env));
|
return VAL(fn_make(params, NULL, body, env));
|
||||||
}
|
}
|
||||||
else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_DLIST, LIST_VAL(expr, 1))) {
|
else if (LIST_N(expr) >= 3 && lake_is_type(TYPE_DLIST, LIST_VAL(expr, 1))) {
|
||||||
list_shift(expr); /* drop the "lambda" symbol */
|
list_shift(expr); /* drop the "lambda" symbol */
|
||||||
LakeDottedList *def = DLIST(list_shift(expr));
|
LakeDottedList *def = DLIST(list_shift(expr));
|
||||||
LakeList *params = dlist_head(def);
|
LakeList *params = dlist_head(def);
|
||||||
|
|
@ -134,7 +134,7 @@ static LakeVal *_lambda(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
LakeList *body = expr;
|
LakeList *body = expr;
|
||||||
return VAL(fn_make(params, varargs, body, env));
|
return VAL(fn_make(params, varargs, body, env));
|
||||||
}
|
}
|
||||||
else if (LIST_N(expr) >= 3 && lk_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
|
else if (LIST_N(expr) >= 3 && lake_is_type(TYPE_SYM, LIST_VAL(expr, 1))) {
|
||||||
list_shift(expr); /* drop the "lambda" symbol */
|
list_shift(expr); /* drop the "lambda" symbol */
|
||||||
LakeSym *varargs = SYM(list_shift(expr));
|
LakeSym *varargs = SYM(list_shift(expr));
|
||||||
LakeList *body = expr;
|
LakeList *body = expr;
|
||||||
|
|
@ -154,7 +154,7 @@ static LakeVal *_if(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
}
|
}
|
||||||
list_shift(expr); /* "if" token */
|
list_shift(expr); /* "if" token */
|
||||||
LakeVal *cond = eval(ctx, env, list_shift(expr));
|
LakeVal *cond = eval(ctx, env, list_shift(expr));
|
||||||
if (lk_is_truthy(ctx, cond)) {
|
if (lake_is_truthy(ctx, cond)) {
|
||||||
return eval(ctx, env, list_shift(expr));
|
return eval(ctx, env, list_shift(expr));
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
|
@ -171,13 +171,13 @@ static LakeVal *_cond(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
LakeVal *pred;
|
LakeVal *pred;
|
||||||
LakeList *conseq;
|
LakeList *conseq;
|
||||||
while (LIST_N(expr)) {
|
while (LIST_N(expr)) {
|
||||||
if (!lk_is_type(TYPE_LIST, LIST_VAL(expr, 0))) {
|
if (!lake_is_type(TYPE_LIST, LIST_VAL(expr, 0))) {
|
||||||
invalid_special_form(expr, "expected a (predicate consequence) pair");
|
invalid_special_form(expr, "expected a (predicate consequence) pair");
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
conseq = LIST(list_shift(expr));
|
conseq = LIST(list_shift(expr));
|
||||||
pred = list_shift(conseq);
|
pred = list_shift(conseq);
|
||||||
if (pred == ELSE || lk_is_truthy(ctx, eval(ctx, env, pred))) {
|
if (pred == ELSE || lake_is_truthy(ctx, eval(ctx, env, pred))) {
|
||||||
return eval_exprs1(ctx, env, conseq);
|
return eval_exprs1(ctx, env, conseq);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -192,14 +192,14 @@ static LakeVal *_when(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
}
|
}
|
||||||
list_shift(expr); /* "when" token */
|
list_shift(expr); /* "when" token */
|
||||||
LakeVal *cond = eval(ctx, env, list_shift(expr));
|
LakeVal *cond = eval(ctx, env, list_shift(expr));
|
||||||
return lk_is_truthy(ctx, cond) ? eval_exprs1(ctx, env, expr) : NULL;
|
return lake_is_truthy(ctx, cond) ? eval_exprs1(ctx, env, expr) : NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
typedef LakeVal *(*handler)(LakeCtx *, Env *, LakeList *);
|
typedef LakeVal *(*handler)(LakeCtx *, Env *, LakeList *);
|
||||||
|
|
||||||
static void define_handler(LakeCtx *ctx, char *name, handler fn)
|
static void define_handler(LakeCtx *ctx, char *name, handler fn)
|
||||||
{
|
{
|
||||||
lk_hash_put(ctx->special_form_handlers, name, (void *)fn);
|
lake_hash_put(ctx->special_form_handlers, name, (void *)fn);
|
||||||
}
|
}
|
||||||
|
|
||||||
void init_special_form_handlers(LakeCtx *ctx)
|
void init_special_form_handlers(LakeCtx *ctx)
|
||||||
|
|
@ -222,13 +222,13 @@ void init_special_form_handlers(LakeCtx *ctx)
|
||||||
bool is_special_form(LakeCtx *ctx, LakeList *expr)
|
bool is_special_form(LakeCtx *ctx, LakeList *expr)
|
||||||
{
|
{
|
||||||
LakeVal *head = LIST_VAL(expr, 0);
|
LakeVal *head = LIST_VAL(expr, 0);
|
||||||
if (!lk_is_type(TYPE_SYM, head)) return FALSE;
|
if (!lake_is_type(TYPE_SYM, head)) return FALSE;
|
||||||
return lk_hash_has(ctx->special_form_handlers, SYM(head)->s);
|
return lake_hash_has(ctx->special_form_handlers, SYM(head)->s);
|
||||||
}
|
}
|
||||||
|
|
||||||
static special_form_handler get_special_form_handler(LakeCtx *ctx, LakeSym *name)
|
static special_form_handler get_special_form_handler(LakeCtx *ctx, LakeSym *name)
|
||||||
{
|
{
|
||||||
return (special_form_handler)lk_hash_get(ctx->special_form_handlers, name->s);
|
return (special_form_handler)lake_hash_get(ctx->special_form_handlers, name->s);
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *eval_special_form(LakeCtx *ctx, Env *env, LakeList *expr)
|
static LakeVal *eval_special_form(LakeCtx *ctx, Env *env, LakeList *expr)
|
||||||
|
|
@ -340,7 +340,7 @@ LakeVal *eval_exprs1(LakeCtx *ctx, Env *env, LakeList *exprs)
|
||||||
LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args)
|
LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeVal *result = NULL;
|
LakeVal *result = NULL;
|
||||||
if (lk_is_type(TYPE_PRIM, fnVal)) {
|
if (lake_is_type(TYPE_PRIM, fnVal)) {
|
||||||
LakePrimitive *prim = PRIM(fnVal);
|
LakePrimitive *prim = PRIM(fnVal);
|
||||||
int arity = prim->arity;
|
int arity = prim->arity;
|
||||||
if (arity == ARITY_VARARGS || LIST_N(args) == arity) {
|
if (arity == ARITY_VARARGS || LIST_N(args) == arity) {
|
||||||
|
|
@ -351,7 +351,7 @@ LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args)
|
||||||
result = NULL;
|
result = NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else if (lk_is_type(TYPE_FN, fnVal)) {
|
else if (lake_is_type(TYPE_FN, fnVal)) {
|
||||||
LakeFn *fn = FN(fnVal);
|
LakeFn *fn = FN(fnVal);
|
||||||
|
|
||||||
/* Check # of params */
|
/* Check # of params */
|
||||||
|
|
|
||||||
16
src/fn.c
16
src/fn.c
|
|
@ -35,31 +35,31 @@ char *fn_repr(LakeFn *fn)
|
||||||
{
|
{
|
||||||
char *s = malloc(8);
|
char *s = malloc(8);
|
||||||
s[0] = '\0';
|
s[0] = '\0';
|
||||||
s = lk_str_append(s, "(lambda ");
|
s = lake_str_append(s, "(lambda ");
|
||||||
char *s2;
|
char *s2;
|
||||||
if (LIST_N(fn->params) && fn->varargs) {
|
if (LIST_N(fn->params) && fn->varargs) {
|
||||||
LakeDottedList *params = dlist_make(fn->params, VAL(fn->varargs));
|
LakeDottedList *params = dlist_make(fn->params, VAL(fn->varargs));
|
||||||
s2 = dlist_repr(params);
|
s2 = dlist_repr(params);
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
}
|
}
|
||||||
else if (fn->varargs) {
|
else if (fn->varargs) {
|
||||||
s2 = lake_repr(fn->varargs);
|
s2 = lake_repr(fn->varargs);
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
s2 = lake_repr(fn->params);
|
s2 = lake_repr(fn->params);
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
}
|
}
|
||||||
s = lk_str_append(s, " ");
|
s = lake_str_append(s, " ");
|
||||||
int i;
|
int i;
|
||||||
for (i = 0; i < LIST_N(fn->body); ++i) {
|
for (i = 0; i < LIST_N(fn->body); ++i) {
|
||||||
s2 = lake_repr(LIST_VAL(fn->body, i));
|
s2 = lake_repr(LIST_VAL(fn->body, i));
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
if (i != LIST_N(fn->body) - 1) s = lk_str_append(s, " ");
|
if (i != LIST_N(fn->body) - 1) s = lake_str_append(s, " ");
|
||||||
}
|
}
|
||||||
return lk_str_append(s, ")");
|
return lake_str_append(s, ")");
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -12,18 +12,18 @@
|
||||||
|
|
||||||
#include "hash.h"
|
#include "hash.h"
|
||||||
|
|
||||||
void lk_hash_put(khash_t(value) *h, char *key, void *val) {
|
void lake_hash_put(khash_t(value) *h, char *key, void *val) {
|
||||||
int ret;
|
int ret;
|
||||||
khiter_t k = kh_put(value, h, key, &ret);
|
khiter_t k = kh_put(value, h, key, &ret);
|
||||||
kh_value(h, k) = val;
|
kh_value(h, k) = val;
|
||||||
}
|
}
|
||||||
|
|
||||||
void *lk_hash_get(khash_t(value) *h, char *key) {
|
void *lake_hash_get(khash_t(value) *h, char *key) {
|
||||||
khiter_t k = kh_get(value, h, key);
|
khiter_t k = kh_get(value, h, key);
|
||||||
return k == kh_end(h) ? NULL : kh_value(h, k);
|
return k == kh_end(h) ? NULL : kh_value(h, k);
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lk_hash_has(khash_t(value) *h, char *key) {
|
bool lake_hash_has(khash_t(value) *h, char *key) {
|
||||||
khiter_t k = kh_get(value, h, key);
|
khiter_t k = kh_get(value, h, key);
|
||||||
return kh_exist(h, k);
|
return kh_exist(h, k);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
12
src/hash.h
12
src/hash.h
|
|
@ -18,13 +18,13 @@
|
||||||
|
|
||||||
KHASH_MAP_INIT_STR(value, void *);
|
KHASH_MAP_INIT_STR(value, void *);
|
||||||
|
|
||||||
typedef khash_t(value) lk_hash_t;
|
typedef khash_t(value) lake_hash_t;
|
||||||
|
|
||||||
#define lk_hash_make() kh_init(value)
|
#define lake_hash_make() kh_init(value)
|
||||||
#define lk_hash_free(h) kh_destroy(value, h)
|
#define lake_hash_free(h) kh_destroy(value, h)
|
||||||
|
|
||||||
bool lk_hash_has(khash_t(value) *h, char *key);
|
bool lake_hash_has(khash_t(value) *h, char *key);
|
||||||
void lk_hash_put(khash_t(value) *h, char *key, void *val);
|
void lake_hash_put(khash_t(value) *h, char *key, void *val);
|
||||||
void *lk_hash_get(khash_t(value) *h, char *key);
|
void *lake_hash_get(khash_t(value) *h, char *key);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
|
|
@ -43,7 +43,7 @@ char *int_repr(LakeInt *i)
|
||||||
LakeStr *int_to_str(LakeInt *i)
|
LakeStr *int_to_str(LakeInt *i)
|
||||||
{
|
{
|
||||||
char *s = int_repr(i);
|
char *s = int_repr(i);
|
||||||
LakeStr *str = lk_str_from_c(s);
|
LakeStr *str = lake_str_from_c(s);
|
||||||
free(s);
|
free(s);
|
||||||
return str;
|
return str;
|
||||||
}
|
}
|
||||||
|
|
|
||||||
20
src/lake.c
20
src/lake.c
|
|
@ -21,12 +21,12 @@
|
||||||
#include "primitive.h"
|
#include "primitive.h"
|
||||||
#include "str.h"
|
#include "str.h"
|
||||||
|
|
||||||
int lk_val_size(void *x)
|
int lake_val_size(void *x)
|
||||||
{
|
{
|
||||||
return VAL(x)->size;
|
return VAL(x)->size;
|
||||||
}
|
}
|
||||||
|
|
||||||
int lk_is_type(LakeType t, void *x)
|
int lake_is_type(LakeType t, void *x)
|
||||||
{
|
{
|
||||||
return VAL(x)->type == t;
|
return VAL(x)->type == t;
|
||||||
}
|
}
|
||||||
|
|
@ -45,7 +45,7 @@ char *lake_repr(void *expr)
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case TYPE_BOOL:
|
case TYPE_BOOL:
|
||||||
s = lk_bool_repr(BOOL(e));
|
s = lake_bool_repr(BOOL(e));
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case TYPE_INT:
|
case TYPE_INT:
|
||||||
|
|
@ -91,17 +91,17 @@ char *lake_repr(void *expr)
|
||||||
return s;
|
return s;
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lk_is_nil(LakeVal *x)
|
bool lake_is_nil(LakeVal *x)
|
||||||
{
|
{
|
||||||
return lk_is_type(TYPE_LIST, x) && LIST_N(LIST(x)) == 0;
|
return lake_is_type(TYPE_LIST, x) && LIST_N(LIST(x)) == 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lake_is(LakeVal *a, LakeVal *b)
|
bool lake_is(LakeVal *a, LakeVal *b)
|
||||||
{
|
{
|
||||||
if (lk_is_type(TYPE_INT, a) && lk_is_type(TYPE_INT, b)) {
|
if (lake_is_type(TYPE_INT, a) && lake_is_type(TYPE_INT, b)) {
|
||||||
return INT_VAL(INT(a)) == INT_VAL(INT(b));
|
return INT_VAL(INT(a)) == INT_VAL(INT(b));
|
||||||
}
|
}
|
||||||
if (lk_is_nil(a) && lk_is_nil(b)) return TRUE;
|
if (lake_is_nil(a) && lake_is_nil(b)) return TRUE;
|
||||||
return a == b;
|
return a == b;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -131,7 +131,7 @@ bool lake_equal(LakeVal *a, LakeVal *b)
|
||||||
return INT_VAL(INT(a)) == INT_VAL(INT(b));
|
return INT_VAL(INT(a)) == INT_VAL(INT(b));
|
||||||
|
|
||||||
case TYPE_STR:
|
case TYPE_STR:
|
||||||
return lk_str_equal(STR(a), STR(b));
|
return lake_str_equal(STR(a), STR(b));
|
||||||
|
|
||||||
case TYPE_LIST:
|
case TYPE_LIST:
|
||||||
return list_equal(LIST(a), LIST(b));
|
return list_equal(LIST(a), LIST(b));
|
||||||
|
|
@ -161,8 +161,8 @@ LakeCtx *lake_init(void)
|
||||||
{
|
{
|
||||||
LakeCtx *ctx = malloc(sizeof(LakeCtx));
|
LakeCtx *ctx = malloc(sizeof(LakeCtx));
|
||||||
ctx->toplevel = env_make(NULL);
|
ctx->toplevel = env_make(NULL);
|
||||||
ctx->symbols = lk_hash_make();
|
ctx->symbols = lake_hash_make();
|
||||||
ctx->special_form_handlers = lk_hash_make();
|
ctx->special_form_handlers = lake_hash_make();
|
||||||
ctx->T = bool_make(TRUE);
|
ctx->T = bool_make(TRUE);
|
||||||
ctx->F = bool_make(FALSE);
|
ctx->F = bool_make(FALSE);
|
||||||
bind_primitives(ctx);
|
bind_primitives(ctx);
|
||||||
|
|
|
||||||
12
src/lake.h
12
src/lake.h
|
|
@ -101,8 +101,8 @@ typedef struct lake_dlist LakeDottedList;
|
||||||
/* Execution context */
|
/* Execution context */
|
||||||
struct lake_ctx {
|
struct lake_ctx {
|
||||||
Env *toplevel;
|
Env *toplevel;
|
||||||
lk_hash_t *symbols;
|
lake_hash_t *symbols;
|
||||||
lk_hash_t *special_form_handlers;
|
lake_hash_t *special_form_handlers;
|
||||||
LakeBool *T;
|
LakeBool *T;
|
||||||
LakeBool *F;
|
LakeBool *F;
|
||||||
};
|
};
|
||||||
|
|
@ -131,7 +131,7 @@ struct lake_fn {
|
||||||
};
|
};
|
||||||
typedef struct lake_fn LakeFn;
|
typedef struct lake_fn LakeFn;
|
||||||
|
|
||||||
#define CALLABLE(x) (lk_is_type(TYPE_FN, x) || lk_is_type(TYPE_PRIM, x))
|
#define CALLABLE(x) (lake_is_type(TYPE_FN, x) || lake_is_type(TYPE_PRIM, x))
|
||||||
|
|
||||||
struct lake_comment {
|
struct lake_comment {
|
||||||
LakeVal base;
|
LakeVal base;
|
||||||
|
|
@ -142,9 +142,9 @@ typedef struct lake_comment LakeComment;
|
||||||
#define COMM_TEXT(x) (x->text)
|
#define COMM_TEXT(x) (x->text)
|
||||||
|
|
||||||
LakeCtx *lake_init(void);
|
LakeCtx *lake_init(void);
|
||||||
int lk_val_size(void *x);
|
int lake_val_size(void *x);
|
||||||
int lk_is_type(LakeType t, void *x);
|
int lake_is_type(LakeType t, void *x);
|
||||||
bool lk_is_nil(LakeVal *x);
|
bool lake_is_nil(LakeVal *x);
|
||||||
bool lake_is(LakeVal *a, LakeVal *b);
|
bool lake_is(LakeVal *a, LakeVal *b);
|
||||||
bool lake_equal(LakeVal *a, LakeVal *b);
|
bool lake_equal(LakeVal *a, LakeVal *b);
|
||||||
char *lake_repr(void *val);
|
char *lake_repr(void *val);
|
||||||
|
|
|
||||||
10
src/list.c
10
src/list.c
|
|
@ -46,7 +46,7 @@ LakeList *list_make(void)
|
||||||
LakeList *list_cons(LakeVal *car, LakeVal *cdr)
|
LakeList *list_cons(LakeVal *car, LakeVal *cdr)
|
||||||
{
|
{
|
||||||
LakeList *list;
|
LakeList *list;
|
||||||
if (lk_is_type(TYPE_LIST, cdr)) {
|
if (lake_is_type(TYPE_LIST, cdr)) {
|
||||||
list = LIST(cdr);
|
list = LIST(cdr);
|
||||||
list_unshift(list, car);
|
list_unshift(list, car);
|
||||||
}
|
}
|
||||||
|
|
@ -176,7 +176,7 @@ bool list_equal(LakeList *a, LakeList *b)
|
||||||
LakeStr *list_to_str(LakeList *list)
|
LakeStr *list_to_str(LakeList *list)
|
||||||
{
|
{
|
||||||
char *s = list_repr(list);
|
char *s = list_repr(list);
|
||||||
LakeStr *str = lk_str_from_c(s);
|
LakeStr *str = lake_str_from_c(s);
|
||||||
free(s);
|
free(s);
|
||||||
return str;
|
return str;
|
||||||
}
|
}
|
||||||
|
|
@ -197,9 +197,9 @@ char *list_repr(LakeList *list)
|
||||||
else {
|
else {
|
||||||
s2 = lake_repr(val);
|
s2 = lake_repr(val);
|
||||||
}
|
}
|
||||||
s = lk_str_append(s, s2);
|
s = lake_str_append(s, s2);
|
||||||
free(s2);
|
free(s2);
|
||||||
if (i != LIST_N(list) - 1) s = lk_str_append(s, " ");
|
if (i != LIST_N(list) - 1) s = lake_str_append(s, " ");
|
||||||
}
|
}
|
||||||
return lk_str_append(s, ")");
|
return lake_str_append(s, ")");
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -284,7 +284,7 @@ static LakeVal *parse_str(Ctx *ctx)
|
||||||
}
|
}
|
||||||
s[i] = '\0';
|
s[i] = '\0';
|
||||||
ch(ctx, '"');
|
ch(ctx, '"');
|
||||||
LakeStr *str = lk_str_from_c(s);
|
LakeStr *str = lake_str_from_c(s);
|
||||||
free(s);
|
free(s);
|
||||||
return VAL(str);
|
return VAL(str);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -49,10 +49,10 @@ char *prim_repr(LakePrimitive *prim)
|
||||||
static LakeVal *_car(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_car(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeList *list = LIST(LIST_VAL(args, 0));
|
LakeList *list = LIST(LIST_VAL(args, 0));
|
||||||
if (lk_is_type(TYPE_LIST, list) && LIST_N(list) > 0) {
|
if (lake_is_type(TYPE_LIST, list) && LIST_N(list) > 0) {
|
||||||
return LIST_VAL(list, 0);
|
return LIST_VAL(list, 0);
|
||||||
}
|
}
|
||||||
if (lk_is_type(TYPE_DLIST, list)) {
|
if (lake_is_type(TYPE_DLIST, list)) {
|
||||||
return VAL(dlist_head(DLIST(list)));
|
return VAL(dlist_head(DLIST(list)));
|
||||||
}
|
}
|
||||||
ERR("not a pair: %s", lake_repr(list));
|
ERR("not a pair: %s", lake_repr(list));
|
||||||
|
|
@ -62,12 +62,12 @@ static LakeVal *_car(LakeCtx *ctx, LakeList *args)
|
||||||
static LakeVal *_cdr(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_cdr(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeList *list = LIST(LIST_VAL(args, 0));
|
LakeList *list = LIST(LIST_VAL(args, 0));
|
||||||
if (lk_is_type(TYPE_LIST, list) && LIST_N(list) > 0) {
|
if (lake_is_type(TYPE_LIST, list) && LIST_N(list) > 0) {
|
||||||
LakeList *cdr = list_copy(list);
|
LakeList *cdr = list_copy(list);
|
||||||
list_shift(cdr);
|
list_shift(cdr);
|
||||||
return VAL(cdr);
|
return VAL(cdr);
|
||||||
}
|
}
|
||||||
if (lk_is_type(TYPE_DLIST, list)) {
|
if (lake_is_type(TYPE_DLIST, list)) {
|
||||||
return dlist_tail(DLIST(list));
|
return dlist_tail(DLIST(list));
|
||||||
}
|
}
|
||||||
ERR("not a pair: %s", lake_repr(list));
|
ERR("not a pair: %s", lake_repr(list));
|
||||||
|
|
@ -84,14 +84,14 @@ static LakeVal *_cons(LakeCtx *ctx, LakeList *args)
|
||||||
static LakeVal *_nullP(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_nullP(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeVal *val = list_shift(args);
|
LakeVal *val = list_shift(args);
|
||||||
LakeBool *is_null = lk_bool_from_int(ctx, lk_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) == 0);
|
LakeBool *is_null = lake_bool_from_int(ctx, lake_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) == 0);
|
||||||
return VAL(is_null);
|
return VAL(is_null);
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *_pairP(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_pairP(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeVal *val = list_shift(args);
|
LakeVal *val = list_shift(args);
|
||||||
LakeBool *is_pair = lk_bool_from_int(ctx, lk_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) > 0);
|
LakeBool *is_pair = lake_bool_from_int(ctx, lake_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) > 0);
|
||||||
return VAL(is_pair);
|
return VAL(is_pair);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -99,25 +99,25 @@ static LakeVal *_isP(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeVal *a = LIST_VAL(args, 0);
|
LakeVal *a = LIST_VAL(args, 0);
|
||||||
LakeVal *b = LIST_VAL(args, 1);
|
LakeVal *b = LIST_VAL(args, 1);
|
||||||
return VAL(lk_bool_from_int(ctx, lake_is(a, b)));
|
return VAL(lake_bool_from_int(ctx, lake_is(a, b)));
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *_equalP(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_equalP(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeVal *a = LIST_VAL(args, 0);
|
LakeVal *a = LIST_VAL(args, 0);
|
||||||
LakeVal *b = LIST_VAL(args, 1);
|
LakeVal *b = LIST_VAL(args, 1);
|
||||||
return VAL(lk_bool_from_int(ctx, lake_equal(a, b)));
|
return VAL(lake_bool_from_int(ctx, lake_equal(a, b)));
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *_not(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_not(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeVal *val = list_shift(args);
|
LakeVal *val = list_shift(args);
|
||||||
LakeBool *not = lk_bool_from_int(ctx, lk_is_false(ctx, val));
|
LakeBool *not = lake_bool_from_int(ctx, lake_is_false(ctx, val));
|
||||||
return VAL(not);
|
return VAL(not);
|
||||||
}
|
}
|
||||||
|
|
||||||
#define ENSURE_INT(x, i) do { \
|
#define ENSURE_INT(x, i) do { \
|
||||||
if (!lk_is_type(TYPE_INT, x)) { \
|
if (!lake_is_type(TYPE_INT, x)) { \
|
||||||
ERR("argument %zu is not an integer: %s", i, lake_repr(x)); \
|
ERR("argument %zu is not an integer: %s", i, lake_repr(x)); \
|
||||||
return NULL; \
|
return NULL; \
|
||||||
} \
|
} \
|
||||||
|
|
@ -221,7 +221,7 @@ static LakeVal *_int_eq(LakeCtx *ctx, LakeList *args)
|
||||||
}
|
}
|
||||||
prev = INT_VAL(INT(v));
|
prev = INT_VAL(INT(v));
|
||||||
}
|
}
|
||||||
return VAL(lk_bool_from_int(ctx, result));
|
return VAL(lake_bool_from_int(ctx, result));
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *_int_lt(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_int_lt(LakeCtx *ctx, LakeList *args)
|
||||||
|
|
@ -242,7 +242,7 @@ static LakeVal *_int_lt(LakeCtx *ctx, LakeList *args)
|
||||||
prev = INT_VAL(INT(v));
|
prev = INT_VAL(INT(v));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return VAL(lk_bool_from_int(ctx, result));
|
return VAL(lake_bool_from_int(ctx, result));
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args)
|
||||||
|
|
@ -263,13 +263,13 @@ static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args)
|
||||||
prev = INT_VAL(INT(v));
|
prev = INT_VAL(INT(v));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return VAL(lk_bool_from_int(ctx, result));
|
return VAL(lake_bool_from_int(ctx, result));
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *_set_carB(LakeCtx *ctx, LakeList *args)
|
static LakeVal *_set_carB(LakeCtx *ctx, LakeList *args)
|
||||||
{
|
{
|
||||||
LakeList *list = LIST(LIST_VAL(args, 0));
|
LakeList *list = LIST(LIST_VAL(args, 0));
|
||||||
if (lk_is_type(TYPE_LIST, list)) {
|
if (lake_is_type(TYPE_LIST, list)) {
|
||||||
LakeVal *new_car = LIST_VAL(args, 1);
|
LakeVal *new_car = LIST_VAL(args, 1);
|
||||||
if (LIST_N(list) == 0) {
|
if (LIST_N(list) == 0) {
|
||||||
list_append(list, new_car);
|
list_append(list, new_car);
|
||||||
|
|
@ -300,7 +300,7 @@ static LakeVal *_display(LakeCtx *ctx, LakeList *args)
|
||||||
#define DEFINE_PREDICATE(name, type) \
|
#define DEFINE_PREDICATE(name, type) \
|
||||||
static LakeVal *_## name ##P(LakeCtx *ctx, LakeList *args) \
|
static LakeVal *_## name ##P(LakeCtx *ctx, LakeList *args) \
|
||||||
{ \
|
{ \
|
||||||
return VAL(lk_bool_from_int(ctx, lk_is_type(type, LIST_VAL(args, 0)))); \
|
return VAL(lake_bool_from_int(ctx, lake_is_type(type, LIST_VAL(args, 0)))); \
|
||||||
}
|
}
|
||||||
|
|
||||||
DEFINE_PREDICATE(symbol, TYPE_SYM)
|
DEFINE_PREDICATE(symbol, TYPE_SYM)
|
||||||
|
|
|
||||||
|
|
@ -142,7 +142,7 @@ int main (int argc, char const *argv[])
|
||||||
LakeVal **argVals = malloc(argc * sizeof(LakeVal *));
|
LakeVal **argVals = malloc(argc * sizeof(LakeVal *));
|
||||||
int i;
|
int i;
|
||||||
for (i = 0; i < argc; ++i) {
|
for (i = 0; i < argc; ++i) {
|
||||||
argVals[i] = VAL(lk_str_from_c((char *)argv[i]));
|
argVals[i] = VAL(lake_str_from_c((char *)argv[i]));
|
||||||
}
|
}
|
||||||
LakeList *args = list_from_array(argc, argVals);
|
LakeList *args = list_from_array(argc, argVals);
|
||||||
free(argVals);
|
free(argVals);
|
||||||
|
|
|
||||||
30
src/str.c
30
src/str.c
|
|
@ -16,7 +16,7 @@
|
||||||
|
|
||||||
#define MIN(a, b) ((a) < (b) ? (a) : (b))
|
#define MIN(a, b) ((a) < (b) ? (a) : (b))
|
||||||
|
|
||||||
static LakeStr *lk_str_alloc(void)
|
static LakeStr *lake_str_alloc(void)
|
||||||
{
|
{
|
||||||
LakeStr *str = malloc(sizeof(LakeStr));
|
LakeStr *str = malloc(sizeof(LakeStr));
|
||||||
VAL(str)->type = TYPE_STR;
|
VAL(str)->type = TYPE_STR;
|
||||||
|
|
@ -24,54 +24,54 @@ static LakeStr *lk_str_alloc(void)
|
||||||
return str;
|
return str;
|
||||||
}
|
}
|
||||||
|
|
||||||
void lk_str_free(LakeStr *str)
|
void lake_str_free(LakeStr *str)
|
||||||
{
|
{
|
||||||
free(STR_S(str));
|
free(STR_S(str));
|
||||||
free(str);
|
free(str);
|
||||||
}
|
}
|
||||||
|
|
||||||
static LakeVal *lk_str_set(LakeStr *str, char *s)
|
static LakeVal *lake_str_set(LakeStr *str, char *s)
|
||||||
{
|
{
|
||||||
STR_N(str) = strlen(s);
|
STR_N(str) = strlen(s);
|
||||||
STR_S(str) = strndup(s, STR_N(str));
|
STR_S(str) = strndup(s, STR_N(str));
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeStr *lk_str_from_c(char *s)
|
LakeStr *lake_str_from_c(char *s)
|
||||||
{
|
{
|
||||||
LakeStr *str = lk_str_alloc();
|
LakeStr *str = lake_str_alloc();
|
||||||
lk_str_set(str, s);
|
lake_str_set(str, s);
|
||||||
return str;
|
return str;
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeStr *lk_str_make(void)
|
LakeStr *lake_str_make(void)
|
||||||
{
|
{
|
||||||
return lk_str_from_c("");
|
return lake_str_from_c("");
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeInt *lk_str_len(LakeStr *str)
|
LakeInt *lake_str_len(LakeStr *str)
|
||||||
{
|
{
|
||||||
return int_from_c(STR_N(str));
|
return int_from_c(STR_N(str));
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeStr *lk_str_copy(LakeStr *str)
|
LakeStr *lake_str_copy(LakeStr *str)
|
||||||
{
|
{
|
||||||
return lk_str_from_c(STR_S(str));
|
return lake_str_from_c(STR_S(str));
|
||||||
}
|
}
|
||||||
|
|
||||||
char *lk_str_val(LakeStr *str)
|
char *lake_str_val(LakeStr *str)
|
||||||
{
|
{
|
||||||
return strndup(STR_S(str), STR_N(str));
|
return strndup(STR_S(str), STR_N(str));
|
||||||
}
|
}
|
||||||
|
|
||||||
bool lk_str_equal(LakeStr *a, LakeStr *b)
|
bool lake_str_equal(LakeStr *a, LakeStr *b)
|
||||||
{
|
{
|
||||||
if (STR_N(a) != STR_N(b)) return FALSE;
|
if (STR_N(a) != STR_N(b)) return FALSE;
|
||||||
size_t n = MIN(STR_N(a), STR_N(b));
|
size_t n = MIN(STR_N(a), STR_N(b));
|
||||||
return strncmp(STR_S(a), STR_S(b), n) == 0;
|
return strncmp(STR_S(a), STR_S(b), n) == 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeStr *lk_str_to_str(LakeStr *str)
|
LakeStr *lake_str_to_str(LakeStr *str)
|
||||||
{
|
{
|
||||||
return lk_str_copy(str);
|
return lake_str_copy(str);
|
||||||
}
|
}
|
||||||
|
|
|
||||||
16
src/str.h
16
src/str.h
|
|
@ -13,13 +13,13 @@
|
||||||
#include "common.h"
|
#include "common.h"
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
|
|
||||||
LakeStr *lk_str_make(void);
|
LakeStr *lake_str_make(void);
|
||||||
void lk_str_free(LakeStr *str);
|
void lake_str_free(LakeStr *str);
|
||||||
LakeStr *lk_str_copy(LakeStr *str);
|
LakeStr *lake_str_copy(LakeStr *str);
|
||||||
LakeStr *lk_str_from_c(char *s);
|
LakeStr *lake_str_from_c(char *s);
|
||||||
char *lk_str_val(LakeStr *str);
|
char *lake_str_val(LakeStr *str);
|
||||||
LakeInt *lk_str_len(LakeStr *str);
|
LakeInt *lake_str_len(LakeStr *str);
|
||||||
bool lk_str_equal(LakeStr *a, LakeStr *b);
|
bool lake_str_equal(LakeStr *a, LakeStr *b);
|
||||||
LakeStr *lk_str_to_str(LakeStr *str);
|
LakeStr *lake_str_to_str(LakeStr *str);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
@ -41,20 +41,20 @@ static LakeSym *sym_alloc(void)
|
||||||
|
|
||||||
LakeSym *sym_intern(LakeCtx *ctx, char *s)
|
LakeSym *sym_intern(LakeCtx *ctx, char *s)
|
||||||
{
|
{
|
||||||
LakeSym *sym = lk_hash_get(ctx->symbols, s);
|
LakeSym *sym = lake_hash_get(ctx->symbols, s);
|
||||||
if (!sym) {
|
if (!sym) {
|
||||||
sym = sym_alloc();
|
sym = sym_alloc();
|
||||||
sym->n = strlen(s);
|
sym->n = strlen(s);
|
||||||
sym->s = strndup(s, sym->n);
|
sym->s = strndup(s, sym->n);
|
||||||
sym->hash = str_hash(s);
|
sym->hash = str_hash(s);
|
||||||
lk_hash_put(ctx->symbols, sym->s, sym);
|
lake_hash_put(ctx->symbols, sym->s, sym);
|
||||||
}
|
}
|
||||||
return sym;
|
return sym;
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeStr *sym_to_str(LakeSym *sym)
|
LakeStr *sym_to_str(LakeSym *sym)
|
||||||
{
|
{
|
||||||
return lk_str_from_c(sym->s);
|
return lake_str_from_c(sym->s);
|
||||||
}
|
}
|
||||||
|
|
||||||
LakeSym *sym_from_str(LakeCtx *ctx, LakeStr *str)
|
LakeSym *sym_from_str(LakeCtx *ctx, LakeStr *str)
|
||||||
|
|
|
||||||
|
|
@ -15,15 +15,38 @@
|
||||||
|
|
||||||
#define TEXT "you are not expected to understand this"
|
#define TEXT "you are not expected to understand this"
|
||||||
|
|
||||||
|
void setup(void);
|
||||||
|
static char *test_comment_make(void);
|
||||||
|
static char *test_comment_from_c(void);
|
||||||
|
static char *test_comment_equal(void);
|
||||||
|
static char *test_comment_repr(void);
|
||||||
|
|
||||||
static LakeStr *text = NULL;
|
static LakeStr *text = NULL;
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[])
|
||||||
|
{
|
||||||
|
setup();
|
||||||
|
return !lt_run_tests("Comments", (test_fn[]){
|
||||||
|
test_comment_make,
|
||||||
|
test_comment_from_c,
|
||||||
|
test_comment_repr,
|
||||||
|
test_comment_equal,
|
||||||
|
NULL
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
void setup(void)
|
||||||
|
{
|
||||||
|
text = lake_str_from_c(TEXT);
|
||||||
|
}
|
||||||
|
|
||||||
/* LakeComment *comment_make(LakeStr *text) */
|
/* LakeComment *comment_make(LakeStr *text) */
|
||||||
static char *test_comment_make(void)
|
static char *test_comment_make(void)
|
||||||
{
|
{
|
||||||
LakeComment *comment = comment_make(text);
|
LakeComment *comment = comment_make(text);
|
||||||
lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment));
|
lt_assert("type is not TYPE_COMM", lake_is_type(TYPE_COMM, comment));
|
||||||
lt_assert("value size is incorrect", lk_val_size(comment) == sizeof(LakeComment));
|
lt_assert("value size is incorrect", lake_val_size(comment) == sizeof(LakeComment));
|
||||||
lt_assert("comment text is incorrect", lk_str_equal(text, COMM_TEXT(comment)));
|
lt_assert("comment text is incorrect", lake_str_equal(text, COMM_TEXT(comment)));
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -31,9 +54,9 @@ static char *test_comment_make(void)
|
||||||
static char *test_comment_from_c(void)
|
static char *test_comment_from_c(void)
|
||||||
{
|
{
|
||||||
LakeComment *comment = comment_from_c(TEXT);
|
LakeComment *comment = comment_from_c(TEXT);
|
||||||
lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment));
|
lt_assert("type is not TYPE_COMM", lake_is_type(TYPE_COMM, comment));
|
||||||
lt_assert("value size is incorrect", lk_val_size(comment) == sizeof(LakeComment));
|
lt_assert("value size is incorrect", lake_val_size(comment) == sizeof(LakeComment));
|
||||||
lt_assert("comment text is incorrect", lk_str_equal(text, COMM_TEXT(comment)));
|
lt_assert("comment text is incorrect", lake_str_equal(text, COMM_TEXT(comment)));
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -57,20 +80,3 @@ static char *test_comment_equal(void)
|
||||||
lt_assert("comment b == c", !comment_equal(b, c));
|
lt_assert("comment b == c", !comment_equal(b, c));
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
void setup(void)
|
|
||||||
{
|
|
||||||
text = lk_str_from_c(TEXT);
|
|
||||||
}
|
|
||||||
|
|
||||||
int main(int argc, char const *argv[])
|
|
||||||
{
|
|
||||||
setup();
|
|
||||||
return !lt_run_tests("Comments", (test_fn[]){
|
|
||||||
test_comment_make,
|
|
||||||
test_comment_from_c,
|
|
||||||
test_comment_repr,
|
|
||||||
test_comment_equal,
|
|
||||||
NULL
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
|
||||||
|
|
@ -13,16 +13,39 @@
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
#include "list.h"
|
#include "list.h"
|
||||||
|
|
||||||
|
void setup(void);
|
||||||
|
static char *test_dlist_make(void);
|
||||||
|
static char *test_dlist_repr(void);
|
||||||
|
static char *test_dlist_equal(void);
|
||||||
|
|
||||||
static LakeList *head;
|
static LakeList *head;
|
||||||
static LakeVal *tail;
|
static LakeVal *tail;
|
||||||
static LakeDottedList *dlist;
|
static LakeDottedList *dlist;
|
||||||
static char *REPR = "(() . ())";
|
static char *REPR = "(() . ())";
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[])
|
||||||
|
{
|
||||||
|
setup();
|
||||||
|
return !lt_run_tests("Dotted Lists", (test_fn[]){
|
||||||
|
test_dlist_make,
|
||||||
|
test_dlist_repr,
|
||||||
|
test_dlist_equal,
|
||||||
|
NULL
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
void setup(void)
|
||||||
|
{
|
||||||
|
head = list_make();
|
||||||
|
tail = VAL(list_make());
|
||||||
|
dlist = dlist_make(head, tail);
|
||||||
|
}
|
||||||
|
|
||||||
/* LakeDottedList *dlist_make(LakeList *head, LakeVal *tail) */
|
/* LakeDottedList *dlist_make(LakeList *head, LakeVal *tail) */
|
||||||
static char *test_dlist_make(void)
|
static char *test_dlist_make(void)
|
||||||
{
|
{
|
||||||
lt_assert("type is not TYPE_DLIST", lk_is_type(TYPE_DLIST, dlist));
|
lt_assert("type is not TYPE_DLIST", lake_is_type(TYPE_DLIST, dlist));
|
||||||
lt_assert("value size is incorrect", lk_val_size(dlist) == sizeof(LakeDottedList));
|
lt_assert("value size is incorrect", lake_val_size(dlist) == sizeof(LakeDottedList));
|
||||||
lt_assert("head value is incorrect",
|
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)));
|
||||||
|
|
@ -66,22 +89,3 @@ static char *test_dlist_equal(void)
|
||||||
lt_assert("dlist a == diff_tail", !dlist_equal(a, diff_tail));
|
lt_assert("dlist a == diff_tail", !dlist_equal(a, diff_tail));
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void setup(void)
|
|
||||||
{
|
|
||||||
head = list_make();
|
|
||||||
tail = VAL(list_make());
|
|
||||||
dlist = dlist_make(head, tail);
|
|
||||||
}
|
|
||||||
|
|
||||||
int main(int argc, char const *argv[])
|
|
||||||
{
|
|
||||||
setup();
|
|
||||||
return !lt_run_tests("Dotted Lists", (test_fn[]){
|
|
||||||
test_dlist_make,
|
|
||||||
test_dlist_repr,
|
|
||||||
test_dlist_equal,
|
|
||||||
NULL
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -12,6 +12,13 @@
|
||||||
#include "env.h"
|
#include "env.h"
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
|
|
||||||
|
void setup(void);
|
||||||
|
static char *test_env_make(void);
|
||||||
|
static char *test_env_define(void);
|
||||||
|
static char *test_env_get(void);
|
||||||
|
static char *test_env_set(void);
|
||||||
|
static char *test_env_is_defined(void);
|
||||||
|
|
||||||
int tests_run;
|
int tests_run;
|
||||||
|
|
||||||
static LakeCtx *lake;
|
static LakeCtx *lake;
|
||||||
|
|
@ -21,6 +28,29 @@ static LakeSym *s_answer;
|
||||||
static LakeVal *answer;
|
static LakeVal *answer;
|
||||||
static LakeSym *s_undef;
|
static LakeSym *s_undef;
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[])
|
||||||
|
{
|
||||||
|
setup();
|
||||||
|
return !lt_run_tests("Environment", (test_fn[]){
|
||||||
|
test_env_make,
|
||||||
|
test_env_define,
|
||||||
|
test_env_set,
|
||||||
|
test_env_get,
|
||||||
|
test_env_is_defined,
|
||||||
|
NULL
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
void setup(void)
|
||||||
|
{
|
||||||
|
lake = lake_init();
|
||||||
|
toplevel = lake->toplevel;
|
||||||
|
firstlevel = env_make(toplevel);
|
||||||
|
s_answer = sym_intern(lake, "answer");
|
||||||
|
answer = VAL(int_from_c(42));
|
||||||
|
s_undef = sym_intern(lake, "undefined");
|
||||||
|
}
|
||||||
|
|
||||||
/* Env *env_make(Env *parent) */
|
/* Env *env_make(Env *parent) */
|
||||||
static char *test_env_make(void)
|
static char *test_env_make(void)
|
||||||
{
|
{
|
||||||
|
|
@ -105,27 +135,3 @@ static char *test_env_get(void)
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void setup(void)
|
|
||||||
{
|
|
||||||
lake = lake_init();
|
|
||||||
toplevel = lake->toplevel;
|
|
||||||
firstlevel = env_make(toplevel);
|
|
||||||
s_answer = sym_intern(lake, "answer");
|
|
||||||
answer = VAL(int_from_c(42));
|
|
||||||
s_undef = sym_intern(lake, "undefined");
|
|
||||||
}
|
|
||||||
|
|
||||||
int main(int argc, char const *argv[])
|
|
||||||
{
|
|
||||||
setup();
|
|
||||||
return !lt_run_tests("Environment", (test_fn[]){
|
|
||||||
test_env_make,
|
|
||||||
test_env_define,
|
|
||||||
test_env_set,
|
|
||||||
test_env_get,
|
|
||||||
test_env_is_defined,
|
|
||||||
NULL
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -13,6 +13,12 @@
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
#include "parse.h"
|
#include "parse.h"
|
||||||
|
|
||||||
|
void setup(void);
|
||||||
|
static char *test_eval(void);
|
||||||
|
static char *test_eval_exprs(void);
|
||||||
|
static char *test_eval_exprs1(void);
|
||||||
|
static char *test_apply(void);
|
||||||
|
|
||||||
int tests_run;
|
int tests_run;
|
||||||
char *failed_test;
|
char *failed_test;
|
||||||
|
|
||||||
|
|
@ -22,6 +28,27 @@ static LakeSym *s_cdr;
|
||||||
static LakePrimitive *p_car;
|
static LakePrimitive *p_car;
|
||||||
static LakePrimitive *p_cdr;
|
static LakePrimitive *p_cdr;
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[])
|
||||||
|
{
|
||||||
|
setup();
|
||||||
|
return !lt_run_tests("Eval & Apply", (test_fn[]){
|
||||||
|
test_eval,
|
||||||
|
test_eval_exprs,
|
||||||
|
test_eval_exprs1,
|
||||||
|
test_apply,
|
||||||
|
NULL
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
void setup(void)
|
||||||
|
{
|
||||||
|
lake = lake_init();
|
||||||
|
s_car = sym_intern(lake, "car");
|
||||||
|
s_cdr = sym_intern(lake, "cdr");
|
||||||
|
p_car = PRIM(eval(lake, lake->toplevel, VAL(s_car)));
|
||||||
|
p_cdr = PRIM(eval(lake, lake->toplevel, VAL(s_cdr)));
|
||||||
|
}
|
||||||
|
|
||||||
/* LakeList *eval_exprs(LakeCtx *ctx, Env *env, LakeList *exprs) */
|
/* LakeList *eval_exprs(LakeCtx *ctx, Env *env, LakeList *exprs) */
|
||||||
static char *test_eval_exprs(void)
|
static char *test_eval_exprs(void)
|
||||||
{
|
{
|
||||||
|
|
@ -89,7 +116,7 @@ static char *test_eval(void)
|
||||||
|
|
||||||
LakeBool *l_bool = lake->T;
|
LakeBool *l_bool = lake->T;
|
||||||
LakeInt *l_int = int_from_c(42);
|
LakeInt *l_int = int_from_c(42);
|
||||||
LakeStr *l_str = lk_str_from_c("i am the walrus");
|
LakeStr *l_str = lake_str_from_c("i am the walrus");
|
||||||
lt_assert("bool does not self evaluate", VAL(l_bool) == EVAL(l_bool));
|
lt_assert("bool does not self evaluate", VAL(l_bool) == EVAL(l_bool));
|
||||||
lt_assert("int does not self evaluate", VAL(l_int) == EVAL(l_int));
|
lt_assert("int does not self evaluate", VAL(l_int) == EVAL(l_int));
|
||||||
lt_assert("string does not self evaluate", VAL(l_str) == EVAL(l_str));
|
lt_assert("string does not self evaluate", VAL(l_str) == EVAL(l_str));
|
||||||
|
|
@ -118,7 +145,7 @@ static char *test_eval(void)
|
||||||
list_append(l_call, VAL(isP));
|
list_append(l_call, VAL(isP));
|
||||||
list_append(l_call, VAL(s_x));
|
list_append(l_call, VAL(s_x));
|
||||||
list_append(l_call, VAL(l_int));
|
list_append(l_call, VAL(l_int));
|
||||||
lt_assert("primitive evaluated incorrectly", lk_is_true(lake, EVAL(l_call)));
|
lt_assert("primitive evaluated incorrectly", lake_is_true(lake, EVAL(l_call)));
|
||||||
list_free(l_call);
|
list_free(l_call);
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
|
|
@ -242,24 +269,3 @@ static char *test_apply(void)
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void setup(void)
|
|
||||||
{
|
|
||||||
lake = lake_init();
|
|
||||||
s_car = sym_intern(lake, "car");
|
|
||||||
s_cdr = sym_intern(lake, "cdr");
|
|
||||||
p_car = PRIM(eval(lake, lake->toplevel, VAL(s_car)));
|
|
||||||
p_cdr = PRIM(eval(lake, lake->toplevel, VAL(s_cdr)));
|
|
||||||
}
|
|
||||||
|
|
||||||
int main(int argc, char const *argv[])
|
|
||||||
{
|
|
||||||
setup();
|
|
||||||
return !lt_run_tests("Eval & Apply", (test_fn[]){
|
|
||||||
test_eval,
|
|
||||||
test_eval_exprs,
|
|
||||||
test_eval_exprs1,
|
|
||||||
test_apply,
|
|
||||||
NULL
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
|
||||||
|
|
@ -14,6 +14,18 @@
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
#include "parse.h"
|
#include "parse.h"
|
||||||
|
|
||||||
|
static char *test_fn_make(void);
|
||||||
|
static char *test_fn_repr(void);
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[])
|
||||||
|
{
|
||||||
|
return !lt_run_tests("Functions", (test_fn[]){
|
||||||
|
test_fn_make,
|
||||||
|
test_fn_repr,
|
||||||
|
NULL
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
/* LakeFn *fn_make(LakeList *params, LakeSym *varargs, LakeList *body, Env *closure) */
|
/* LakeFn *fn_make(LakeList *params, LakeSym *varargs, LakeList *body, Env *closure) */
|
||||||
static char *test_fn_make(void)
|
static char *test_fn_make(void)
|
||||||
{
|
{
|
||||||
|
|
@ -60,12 +72,3 @@ static char *test_fn_repr(void)
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
int main(int argc, char const *argv[])
|
|
||||||
{
|
|
||||||
return !lt_run_tests("Functions", (test_fn[]){
|
|
||||||
test_fn_make,
|
|
||||||
test_fn_repr,
|
|
||||||
NULL
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
@ -12,6 +12,20 @@
|
||||||
#include "laketest.h"
|
#include "laketest.h"
|
||||||
#include "lake.h"
|
#include "lake.h"
|
||||||
|
|
||||||
|
static char *test_int_make(void);
|
||||||
|
static char *test_int_from_c(void);
|
||||||
|
static char *test_int_repr(void);
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[])
|
||||||
|
{
|
||||||
|
return !lt_run_tests("Integers", (test_fn[]){
|
||||||
|
test_int_make,
|
||||||
|
test_int_from_c,
|
||||||
|
test_int_repr,
|
||||||
|
NULL
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
/* LakeInt *int_make(void) */
|
/* LakeInt *int_make(void) */
|
||||||
static char *test_int_make(void)
|
static char *test_int_make(void)
|
||||||
{
|
{
|
||||||
|
|
@ -51,13 +65,3 @@ static char *test_int_repr(void)
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
int main(int argc, char const *argv[])
|
|
||||||
{
|
|
||||||
return !lt_run_tests("Integers", (test_fn[]){
|
|
||||||
test_int_make,
|
|
||||||
test_int_from_c,
|
|
||||||
test_int_repr,
|
|
||||||
NULL
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
@ -17,8 +17,33 @@
|
||||||
#include "eval.h"
|
#include "eval.h"
|
||||||
#include "parse.h"
|
#include "parse.h"
|
||||||
|
|
||||||
|
void setup(void);
|
||||||
|
static char *test_lake_version(void);
|
||||||
|
static char *test_lake_init(void);
|
||||||
|
static char *test_lake_is(void);
|
||||||
|
static char *test_lake_equal(void);
|
||||||
|
static char *test_lake_repr(void);
|
||||||
|
|
||||||
static LakeCtx *lake;
|
static LakeCtx *lake;
|
||||||
|
|
||||||
|
int main(int argc, char const *argv[])
|
||||||
|
{
|
||||||
|
setup();
|
||||||
|
return !lt_run_tests("Lake", (test_fn[]){
|
||||||
|
test_lake_version,
|
||||||
|
test_lake_init,
|
||||||
|
test_lake_is,
|
||||||
|
test_lake_equal,
|
||||||
|
test_lake_repr,
|
||||||
|
NULL
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
void setup(void)
|
||||||
|
{
|
||||||
|
lake = lake_init();
|
||||||
|
}
|
||||||
|
|
||||||
/* #define LAKE_VERSION "0.1" */
|
/* #define LAKE_VERSION "0.1" */
|
||||||
static char *test_lake_version(void)
|
static char *test_lake_version(void)
|
||||||
{
|
{
|
||||||
|
|
@ -36,10 +61,10 @@ static char *test_lake_init(void)
|
||||||
NULL != lake->special_form_handlers);
|
NULL != lake->special_form_handlers);
|
||||||
lt_assert("T is null", NULL != lake->T);
|
lt_assert("T is null", NULL != lake->T);
|
||||||
lt_assert("F is null", NULL != lake->F);
|
lt_assert("F is null", NULL != lake->F);
|
||||||
lt_assert("T is not a boolean", lk_is_type(TYPE_BOOL, lake->T));
|
lt_assert("T is not a boolean", lake_is_type(TYPE_BOOL, lake->T));
|
||||||
lt_assert("F is not a boolean", lk_is_type(TYPE_BOOL, lake->F));
|
lt_assert("F is not a boolean", lake_is_type(TYPE_BOOL, lake->F));
|
||||||
lt_assert("value of T is zero", lk_bool_val(lake->T));
|
lt_assert("value of T is zero", lake_bool_val(lake->T));
|
||||||
lt_assert("value of F is non-zero", !lk_bool_val(lake->F));
|
lt_assert("value of F is non-zero", !lake_bool_val(lake->F));
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -80,7 +105,7 @@ static char *test_lake_equal(void)
|
||||||
{
|
{
|
||||||
LakeInt *i = int_from_c(42);
|
LakeInt *i = int_from_c(42);
|
||||||
LakeInt *j = int_from_c(42);
|
LakeInt *j = int_from_c(42);
|
||||||
LakeStr *arthur = lk_str_from_c("arthur");
|
LakeStr *arthur = lake_str_from_c("arthur");
|
||||||
|
|
||||||
// values with different types are never equal
|
// values with different types are never equal
|
||||||
lt_assert("values with different types are equal", !_equal(i, arthur));
|
lt_assert("values with different types are equal", !_equal(i, arthur));
|
||||||
|
|
@ -116,14 +141,14 @@ static char *test_lake_equal(void)
|
||||||
lt_assert("int is not equal to itself", _equal(i, i));
|
lt_assert("int is not equal to itself", _equal(i, i));
|
||||||
|
|
||||||
// strings are compared by value
|
// strings are compared by value
|
||||||
LakeStr *arthur2 = lk_str_from_c("arthur");
|
LakeStr *arthur2 = lake_str_from_c("arthur");
|
||||||
LakeStr *zaphod = lk_str_from_c("zaphod");
|
LakeStr *zaphod = lake_str_from_c("zaphod");
|
||||||
lt_assert("string is not equal to itself", _equal(arthur, arthur));
|
lt_assert("string is not equal to itself", _equal(arthur, arthur));
|
||||||
lt_assert("string is not equal to itself", _equal(arthur, arthur2));
|
lt_assert("string is not equal to itself", _equal(arthur, arthur2));
|
||||||
lt_assert("different strings are equal", !_equal(arthur, zaphod));
|
lt_assert("different strings are equal", !_equal(arthur, zaphod));
|
||||||
|
|
||||||
// lists are compared by value
|
// lists are compared by value
|
||||||
#define S(s) VAL(lk_str_from_c(s))
|
#define S(s) VAL(lake_str_from_c(s))
|
||||||
LakeList *fruits = list_make();
|
LakeList *fruits = list_make();
|
||||||
list_append(fruits, S("mango"));
|
list_append(fruits, S("mango"));
|
||||||
list_append(fruits, S("pear"));
|
list_append(fruits, S("pear"));
|
||||||
|
|
@ -177,8 +202,8 @@ static char *test_lake_repr(void)
|
||||||
// result in a value equal to the original passed to lake_repr.
|
// result in a value equal to the original passed to lake_repr.
|
||||||
LakeList *vals = list_make();
|
LakeList *vals = list_make();
|
||||||
list_append(vals, VAL(sym_intern(lake, "symbol")));
|
list_append(vals, VAL(sym_intern(lake, "symbol")));
|
||||||
list_append(vals, VAL(lk_str_from_c("string")));
|
list_append(vals, VAL(lake_str_from_c("string")));
|
||||||
list_append(vals, VAL(lk_bool_from_int(lake, TRUE)));
|
list_append(vals, VAL(lake_bool_from_int(lake, TRUE)));
|
||||||
list_append(vals, VAL(int_from_c(42)));
|
list_append(vals, VAL(int_from_c(42)));
|
||||||
list_append(vals, VAL(vals));
|
list_append(vals, VAL(vals));
|
||||||
list_append(vals, VAL(dlist_make(vals, VAL(int_from_c(4919)))));
|
list_append(vals, VAL(dlist_make(vals, VAL(int_from_c(4919)))));
|
||||||
|
|
@ -188,21 +213,3 @@ static char *test_lake_repr(void)
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
void setup(void)
|
|
||||||
{
|
|
||||||
lake = lake_init();
|
|
||||||
}
|
|
||||||
|
|
||||||
int main(int argc, char const *argv[])
|
|
||||||
{
|
|
||||||
setup();
|
|
||||||
return !lt_run_tests("Lake", (test_fn[]){
|
|
||||||
test_lake_version,
|
|
||||||
test_lake_init,
|
|
||||||
test_lake_is,
|
|
||||||
test_lake_equal,
|
|
||||||
test_lake_repr,
|
|
||||||
NULL
|
|
||||||
});
|
|
||||||
}
|
|
||||||
Loading…
Reference in a new issue