diff --git a/.clang-format b/.clang-format new file mode 100644 index 0000000..2d37154 --- /dev/null +++ b/.clang-format @@ -0,0 +1,13 @@ +{ + BasedOnStyle: LLVM, + UseTab: Never, + IndentWidth: 4, + TabWidth: 4, + BreakBeforeBraces: Allman, + AllowShortIfStatementsOnASingleLine: true, + IndentCaseLabels: false, + ColumnLimit: 80, + AccessModifierOffset: -4, + NamespaceIndentation: All, + FixNamespaceComments: false, +} diff --git a/Makefile b/Makefile index 7b1bf44..dff430d 100644 --- a/Makefile +++ b/Makefile @@ -18,4 +18,7 @@ test: test_clean: cd test && make clean -.PHONY: all clean test test_clean +format: + script/clang-format + +.PHONY: all clean test test_clean format diff --git a/script/clang-format b/script/clang-format new file mode 100755 index 0000000..b6c5e59 --- /dev/null +++ b/script/clang-format @@ -0,0 +1,7 @@ +#!/usr/bin/env zsh + +set -euo pipefail + +for file in src/**/*.[ch] test/**/*.[ch]; do + clang-format -i "$file" +done diff --git a/src/bool.c b/src/bool.c index 1141fe1..d49e4ae 100644 --- a/src/bool.c +++ b/src/bool.c @@ -1,58 +1,43 @@ -/** - * bool.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * bool.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include #include "bool.h" #include "common.h" #include "lake.h" +#include -bool lake_bool_val(LakeBool *b) -{ - return b->val; -} +bool lake_bool_val(LakeBool *b) { return b->val; } -bool lake_is_true(LakeCtx *ctx, LakeVal *x) -{ - return VAL(x) == VAL(ctx->T); -} +bool lake_is_true(LakeCtx *ctx, LakeVal *x) { return VAL(x) == VAL(ctx->T); } -bool lake_is_false(LakeCtx *ctx, LakeVal *x) -{ - return VAL(x) == VAL(ctx->F); -} +bool lake_is_false(LakeCtx *ctx, LakeVal *x) { return VAL(x) == VAL(ctx->F); } -bool lake_is_truthy(LakeCtx *ctx, LakeVal *x) -{ - return !lake_is_false(ctx, x); -} +bool lake_is_truthy(LakeCtx *ctx, LakeVal *x) { return !lake_is_false(ctx, x); } -bool lake_is_falsy(LakeCtx *ctx, LakeVal *x) -{ - return lake_is_false(ctx, x); -} +bool lake_is_falsy(LakeCtx *ctx, LakeVal *x) { return lake_is_false(ctx, x); } LakeBool *lake_bool_from_int(LakeCtx *ctx, int n) { - return n ? ctx->T : ctx->F; + return n ? ctx->T : ctx->F; } char *lake_bool_repr(LakeBool *b) { - return strdup(lake_bool_val(b) ? "#t" : "#f"); + return strdup(lake_bool_val(b) ? "#t" : "#f"); } LakeVal *lake_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y) { - return lake_is_truthy(ctx, x) && lake_is_truthy(ctx, y) ? y : x; + return lake_is_truthy(ctx, x) && lake_is_truthy(ctx, y) ? y : x; } LakeVal *lake_bool_or(LakeCtx *ctx, LakeVal *x, LakeVal *y) { - return lake_is_truthy(ctx, x) ? x : y; + return lake_is_truthy(ctx, x) ? x : y; } diff --git a/src/bool.h b/src/bool.h index 55590a6..fff6c53 100644 --- a/src/bool.h +++ b/src/bool.h @@ -1,11 +1,11 @@ -/** - * bool.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * bool.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_BOOL_H #define _LAKE_BOOL_H diff --git a/src/comment.c b/src/comment.c index b60acf2..25eefa6 100644 --- a/src/comment.c +++ b/src/comment.c @@ -1,44 +1,44 @@ -/** - * comment.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * comment.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include "common.h" #include "comment.h" +#include "common.h" #include "lake.h" #include "str.h" +#include static LakeComment *comment_alloc(void) { - LakeComment *comment = malloc(sizeof(LakeComment)); - VAL(comment)->type = TYPE_COMM; - VAL(comment)->size = sizeof(LakeComment); - return comment; + LakeComment *comment = malloc(sizeof(LakeComment)); + VAL(comment)->type = TYPE_COMM; + VAL(comment)->size = sizeof(LakeComment); + return comment; } LakeComment *comment_make(LakeStr *text) { - LakeComment *comment = comment_alloc(); - comment->text = text; - return comment; + LakeComment *comment = comment_alloc(); + comment->text = text; + return comment; } LakeComment *comment_from_c(char *text) { - return comment_make(lake_str_from_c(text)); + return comment_make(lake_str_from_c(text)); } char *comment_repr(LakeComment *comment) { - return strndup(STR_S(comment->text), STR_N(comment->text)); + return strndup(STR_S(comment->text), STR_N(comment->text)); } bool comment_equal(LakeComment *a, LakeComment *b) { - return lake_str_equal(COMM_TEXT(a), COMM_TEXT(b)); + return lake_str_equal(COMM_TEXT(a), COMM_TEXT(b)); } diff --git a/src/comment.h b/src/comment.h index 6d802cc..b690e41 100644 --- a/src/comment.h +++ b/src/comment.h @@ -1,11 +1,11 @@ -/** - * comment.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * comment.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_COMMENT_H #define _LAKE_COMMENT_H diff --git a/src/common.c b/src/common.c index 5d1fa95..33fb828 100644 --- a/src/common.c +++ b/src/common.c @@ -1,21 +1,21 @@ -/** - * common.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * common.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #include -#include -#include #include +#include +#include char *lake_str_append(char *s1, char *s2) { - size_t n2 = strlen(s2); - s1 = realloc(s1, strlen(s1) + n2 + 1); - strncat(s1, s2, n2); - return s1; + size_t n2 = strlen(s2); + s1 = realloc(s1, strlen(s1) + n2 + 1); + strncat(s1, s2, n2); + return s1; } diff --git a/src/common.h b/src/common.h index fe9f8d3..4a2cc7a 100644 --- a/src/common.h +++ b/src/common.h @@ -1,11 +1,11 @@ -/** - * common.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * common.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_COMMON_H #define _LAKE_COMMON_H diff --git a/src/dlist.c b/src/dlist.c index 5b79174..65615e2 100644 --- a/src/dlist.c +++ b/src/dlist.c @@ -1,11 +1,11 @@ -/** - * dlist.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * dlist.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #include "dlist.h" #include "common.h" @@ -13,62 +13,59 @@ static LakeDottedList *dlist_alloc(void) { - LakeDottedList *dlist = malloc(sizeof(LakeDottedList)); - VAL(dlist)->type = TYPE_DLIST; - VAL(dlist)->size = sizeof(LakeDottedList); - return dlist; + LakeDottedList *dlist = malloc(sizeof(LakeDottedList)); + VAL(dlist)->type = TYPE_DLIST; + VAL(dlist)->size = sizeof(LakeDottedList); + return dlist; } LakeDottedList *dlist_make(LakeList *head, LakeVal *tail) { - LakeDottedList *dlist = dlist_alloc(); - dlist->head = head; - dlist->tail = tail; - return dlist; + LakeDottedList *dlist = dlist_alloc(); + dlist->head = head; + dlist->tail = tail; + return dlist; } -LakeList *dlist_head(LakeDottedList *dlist) -{ - return dlist->head; -} +LakeList *dlist_head(LakeDottedList *dlist) { return dlist->head; } -LakeVal *dlist_tail(LakeDottedList *dlist) -{ - return dlist->tail; -} +LakeVal *dlist_tail(LakeDottedList *dlist) { return dlist->tail; } char *dlist_repr(LakeDottedList *dlist) { - char *s = malloc(2); - s[0] = '('; - s[1] = '\0'; - int i; - char *s2; - if (dlist->head && LIST_N(dlist->head)) { - for (i = 0; i < LIST_N(dlist->head); ++i) { - s2 = lake_repr(LIST_VAL(dlist->head, i)); - s = lake_str_append(s, s2); - free(s2); - if (i != LIST_N(dlist->head) - 1) s = lake_str_append(s, " "); + char *s = malloc(2); + s[0] = '('; + s[1] = '\0'; + int i; + char *s2; + if (dlist->head && LIST_N(dlist->head)) + { + for (i = 0; i < LIST_N(dlist->head); ++i) + { + s2 = lake_repr(LIST_VAL(dlist->head, i)); + s = lake_str_append(s, s2); + free(s2); + if (i != LIST_N(dlist->head) - 1) s = lake_str_append(s, " "); + } } - } - else if (dlist->head) { - s2 = lake_repr(dlist->head); + else if (dlist->head) + { + s2 = lake_repr(dlist->head); + s = lake_str_append(s, s2); + free(s2); + } + s = lake_str_append(s, " . "); + s2 = lake_repr(dlist->tail); s = lake_str_append(s, s2); free(s2); - } - s = lake_str_append(s, " . "); - s2 = lake_repr(dlist->tail); - s = lake_str_append(s, s2); - free(s2); - return lake_str_append(s, ")"); + return lake_str_append(s, ")"); } 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); - return lake_equal(headA, headB) && lake_equal(tailA, tailB); + 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); } diff --git a/src/dlist.h b/src/dlist.h index 3d027cd..5bd9f77 100644 --- a/src/dlist.h +++ b/src/dlist.h @@ -1,11 +1,11 @@ -/** - * dlist.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * dlist.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_DLIST_H #define _LAKE_DLIST_H diff --git a/src/env.c b/src/env.c index ffe2c42..49f1432 100644 --- a/src/env.c +++ b/src/env.c @@ -1,59 +1,61 @@ -/** - * env.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * env.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include +#include "env.h" #include "common.h" #include "hash.h" #include "lake.h" -#include "env.h" +#include +#include Env *env_make(Env *parent) { - Env *env = malloc(sizeof(Env)); - env->parent = parent; - env->bindings = lake_hash_make(); - return env; + Env *env = malloc(sizeof(Env)); + env->parent = parent; + env->bindings = lake_hash_make(); + return env; } Env *env_is_defined(Env *env, LakeSym *key) { - if (lake_hash_get(env->bindings, key->s) != NULL) return env; - return env->parent ? env_is_defined(env->parent, key) : NULL; + if (lake_hash_get(env->bindings, key->s) != NULL) return env; + return env->parent ? env_is_defined(env->parent, key) : NULL; } static void env_put(Env *env, LakeSym *key, LakeVal *val) { - lake_hash_put(env->bindings, key->s, val); + lake_hash_put(env->bindings, key->s, val); } LakeVal *env_define(Env *env, LakeSym *key, LakeVal *val) { - env_put(env, key, val); - return val; + env_put(env, key, val); + return val; } LakeVal *env_set(Env *env, LakeSym *key, LakeVal *val) { - Env *definedEnv; - if (!(definedEnv = env_is_defined(env, key))) { - return NULL; - } - env_put(definedEnv, key, val); - return val; + Env *definedEnv; + if (!(definedEnv = env_is_defined(env, key))) + { + return NULL; + } + env_put(definedEnv, key, val); + return val; } LakeVal *env_get(Env *env, LakeSym *key) { - LakeVal *val = lake_hash_get(env->bindings, key->s); - if (!val && env->parent) { - val = env_get(env->parent, key); - } - return val; + LakeVal *val = lake_hash_get(env->bindings, key->s); + if (!val && env->parent) + { + val = env_get(env->parent, key); + } + return val; } diff --git a/src/env.h b/src/env.h index 1122bed..2985b73 100644 --- a/src/env.h +++ b/src/env.h @@ -1,11 +1,11 @@ -/** - * env.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * env.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_ENV_H #define _LAKE_ENV_H @@ -13,9 +13,10 @@ #include "common.h" #include "hash.h" -struct env { - struct env *parent; - lake_hash_t *bindings; +struct env +{ + struct env *parent; + lake_hash_t *bindings; }; typedef struct env Env; diff --git a/src/eval.c b/src/eval.c index 4cd947c..fb99d6c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1,392 +1,446 @@ -/** - * eval.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * eval.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include -#include +#include "eval.h" #include "bool.h" #include "common.h" #include "env.h" -#include "eval.h" #include "fn.h" #include "lake.h" #include "parse.h" +#include +#include +#include -typedef LakeVal *(*special_form_handler)(LakeCtx *ctx, Env *env, LakeList *expr); +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(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 */ static LakeVal *_quote(LakeCtx *ctx, Env *env, LakeList *expr) { - if (LIST_N(expr) == 2) { - return list_pop(expr); - } - invalid_special_form(expr, "quote requires exactly one parameter"); - return NULL; + if (LIST_N(expr) == 2) + { + return list_pop(expr); + } + invalid_special_form(expr, "quote requires exactly one parameter"); + return NULL; } static LakeVal *_and(LakeCtx *ctx, Env *env, LakeList *expr) { - /* drop the "and" symbol */ - list_shift(expr); + /* drop the "and" symbol */ + list_shift(expr); - /* (and ...) */ - LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->T); - while (lake_is_truthy(ctx, result) && LIST_N(expr) > 0) { - result = lake_bool_and(ctx, result, eval(ctx, env, list_shift(expr))); - } - return result; + /* (and ...) */ + LakeVal *result = + LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->T); + while (lake_is_truthy(ctx, result) && LIST_N(expr) > 0) + { + result = lake_bool_and(ctx, result, eval(ctx, env, list_shift(expr))); + } + return result; } static LakeVal *_or(LakeCtx *ctx, Env *env, LakeList *expr) { - /* drop the "or" symbol */ - list_shift(expr); + /* drop the "or" symbol */ + list_shift(expr); - /* (or ...) */ - LakeVal *result = LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->F); - while (lake_is_falsy(ctx, result) && LIST_N(expr) > 0) { - result = lake_bool_or(ctx, result, eval(ctx, env, list_shift(expr))); - } - return result; + /* (or ...) */ + LakeVal *result = + LIST_N(expr) ? eval(ctx, env, list_shift(expr)) : VAL(ctx->F); + while (lake_is_falsy(ctx, result) && LIST_N(expr) > 0) + { + result = lake_bool_or(ctx, result, eval(ctx, env, list_shift(expr))); + } + return result; } static LakeVal *_setB(LakeCtx *ctx, Env *env, LakeList *expr) { - /* (set! x 42) */ - if (LIST_N(expr) == 3 && lake_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_repr(var)); + /* (set! x 42) */ + if (LIST_N(expr) == 3 && lake_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_repr(var)); + } } - } - else { - invalid_special_form(expr, "set! requires exactly 2 parameters"); - } - return NULL; + else + { + invalid_special_form(expr, "set! requires exactly 2 parameters"); + } + return NULL; } 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) */ - if (LIST_N(expr) == 3 && lake_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); - env_define(env, var, eval(ctx, env, form)); - } + /* (define x 42) */ + if (LIST_N(expr) == 3 && lake_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); + env_define(env, var, eval(ctx, env, form)); + } - /* (define (inc x) (+ 1 x)) */ - else if (LIST_N(expr) >= 3 && lake_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)); - LakeList *body = expr; - env_define(env, var, VAL(fn_make(params, NULL, body, env))); - } + /* (define (inc x) (+ 1 x)) */ + else if (LIST_N(expr) >= 3 && lake_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)); + LakeList *body = expr; + env_define(env, var, VAL(fn_make(params, NULL, body, env))); + } - /* (define (print format . args) (...)) */ - else if (LIST_N(expr) >= 3 && lake_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)); - LakeSym *var = SYM(list_shift(params)); - LakeList *body = expr; - env_define(env, var, VAL(fn_make(params, varargs, body, env))); - } + /* (define (print format . args) (...)) */ + else if (LIST_N(expr) >= 3 && lake_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)); + LakeSym *var = SYM(list_shift(params)); + LakeList *body = expr; + env_define(env, var, VAL(fn_make(params, varargs, body, env))); + } - else { - invalid_special_form(expr, "define requires at least 2 parameters"); - } + else + { + invalid_special_form(expr, "define requires at least 2 parameters"); + } - return NULL; + return NULL; } static LakeVal *_lambda(LakeCtx *ctx, Env *env, LakeList *expr) { /* (lambda (a b c) ...) */ - if (LIST_N(expr) >= 3 && lake_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 && lake_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 *body = expr; - return VAL(fn_make(params, varargs, body, env)); - } - else if (LIST_N(expr) >= 3 && lake_is_type(TYPE_SYM, LIST_VAL(expr, 1))) { - list_shift(expr); /* drop the "lambda" symbol */ - LakeSym *varargs = SYM(list_shift(expr)); - LakeList *body = expr; - return VAL(fn_make(list_make(), varargs, body, env)); - } - else { - invalid_special_form(expr, "lambda requires at least 2 parameters"); - return NULL; - } + if (LIST_N(expr) >= 3 && lake_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 && lake_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 *body = expr; + return VAL(fn_make(params, varargs, body, env)); + } + else if (LIST_N(expr) >= 3 && lake_is_type(TYPE_SYM, LIST_VAL(expr, 1))) + { + list_shift(expr); /* drop the "lambda" symbol */ + LakeSym *varargs = SYM(list_shift(expr)); + LakeList *body = expr; + return VAL(fn_make(list_make(), varargs, body, env)); + } + else + { + invalid_special_form(expr, "lambda requires at least 2 parameters"); + return NULL; + } } static LakeVal *_if(LakeCtx *ctx, Env *env, LakeList *expr) { - if (LIST_N(expr) != 3) { - invalid_special_form(expr, "if requires 3 parameters"); - return NULL; - } - list_shift(expr); /* "if" token */ - LakeVal *cond = eval(ctx, env, list_shift(expr)); - if (lake_is_truthy(ctx, cond)) { - return eval(ctx, env, list_shift(expr)); - } - else { - return eval(ctx, env, LIST_VAL(expr, 1)); - } + if (LIST_N(expr) != 3) + { + invalid_special_form(expr, "if requires 3 parameters"); + return NULL; + } + list_shift(expr); /* "if" token */ + LakeVal *cond = eval(ctx, env, list_shift(expr)); + if (lake_is_truthy(ctx, cond)) + { + return eval(ctx, env, list_shift(expr)); + } + else + { + return eval(ctx, env, LIST_VAL(expr, 1)); + } } static LakeVal *_cond(LakeCtx *ctx, Env *env, LakeList *expr) { - static LakeVal *ELSE = NULL; - if (!ELSE) ELSE = VAL(sym_intern(ctx, "else")); + static LakeVal *ELSE = NULL; + if (!ELSE) ELSE = VAL(sym_intern(ctx, "else")); - list_shift(expr); /* "cond" token */ - LakeVal *pred; - LakeList *conseq; - while (LIST_N(expr)) { - if (!lake_is_type(TYPE_LIST, LIST_VAL(expr, 0))) { - invalid_special_form(expr, "expected a (predicate consequence) pair"); - return NULL; + list_shift(expr); /* "cond" token */ + LakeVal *pred; + LakeList *conseq; + while (LIST_N(expr)) + { + if (!lake_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 || lake_is_truthy(ctx, eval(ctx, env, pred))) + { + return eval_exprs1(ctx, env, conseq); + } } - conseq = LIST(list_shift(expr)); - pred = list_shift(conseq); - if (pred == ELSE || lake_is_truthy(ctx, eval(ctx, env, pred))) { - return eval_exprs1(ctx, env, conseq); - } - } - return NULL; + return NULL; } static LakeVal *_when(LakeCtx *ctx, Env *env, LakeList *expr) { - if (LIST_N(expr) < 2) { - invalid_special_form(expr, "when requires at least 2 parameters"); - return NULL; - } - list_shift(expr); /* "when" token */ - LakeVal *cond = eval(ctx, env, list_shift(expr)); - return lake_is_truthy(ctx, cond) ? eval_exprs1(ctx, env, expr) : NULL; + if (LIST_N(expr) < 2) + { + invalid_special_form(expr, "when requires at least 2 parameters"); + return NULL; + } + list_shift(expr); /* "when" token */ + LakeVal *cond = eval(ctx, env, list_shift(expr)); + return lake_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) { - lake_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) { - /* 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); */ + /* 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); */ } bool is_special_form(LakeCtx *ctx, LakeList *expr) { - LakeVal *head = LIST_VAL(expr, 0); - if (!lake_is_type(TYPE_SYM, head)) return FALSE; - return lake_hash_has(ctx->special_form_handlers, SYM(head)->s); + LakeVal *head = LIST_VAL(expr, 0); + if (!lake_is_type(TYPE_SYM, head)) return FALSE; + 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)lake_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) { - LakeSym *name = SYM(LIST_VAL(expr, 0)); - special_form_handler handler = get_special_form_handler(ctx, name); - if (handler) { - return handler(ctx, env, list_copy(expr)); - } - ERR("unrecognized special form: %s", sym_repr(name)); - return NULL; + LakeSym *name = SYM(LIST_VAL(expr, 0)); + special_form_handler handler = get_special_form_handler(ctx, name); + if (handler) + { + return handler(ctx, env, list_copy(expr)); + } + 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))); + return eval(ctx, env, parse_expr(ctx, s, strlen(s))); } LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr) { - LakeVal *result; - LakeList *list; + LakeVal *result; + LakeList *list; - switch (expr->type) { + switch (expr->type) + { /* self evaluating types */ case TYPE_BOOL: case TYPE_INT: case TYPE_STR: - result = expr; - break; + result = expr; + break; case TYPE_SYM: - result = env_get(env, (void *)SYM(expr)); - if (!result) { - ERR("undefined variable: %s", sym_repr(SYM(expr))); - } - break; + result = env_get(env, (void *)SYM(expr)); + if (!result) + { + ERR("undefined variable: %s", sym_repr(SYM(expr))); + } + break; case TYPE_DLIST: - ERR("malformed function call"); - result = NULL; - break; + ERR("malformed function call"); + result = NULL; + break; case TYPE_COMM: - result = NULL; - break; + result = NULL; + break; case TYPE_LIST: - list = LIST(expr); + list = LIST(expr); - if (LIST_N(list) == 0) { - result = expr; - } - else { - if (is_special_form(ctx, list)) { - result = eval_special_form(ctx, env, list); + if (LIST_N(list) == 0) + { + result = expr; } - else { - LakeVal *fn = eval(ctx, env, LIST_VAL(list, 0)); - if (!fn) { - return NULL; - } - LakeList *args = list_make_with_capacity(LIST_N(list) - 1); - int i; - LakeVal *v; - for (i = 1; i < LIST_N(list); ++i) { - v = eval(ctx, env, LIST_VAL(list, i)); - if (v != NULL) { - list_append(args, v); + else + { + if (is_special_form(ctx, list)) + { + result = eval_special_form(ctx, env, list); } - else { - list_free(args); - result = NULL; - goto done; + else + { + LakeVal *fn = eval(ctx, env, LIST_VAL(list, 0)); + if (!fn) + { + return NULL; + } + LakeList *args = list_make_with_capacity(LIST_N(list) - 1); + int i; + LakeVal *v; + for (i = 1; i < LIST_N(list); ++i) + { + v = eval(ctx, env, LIST_VAL(list, i)); + if (v != NULL) + { + list_append(args, v); + } + else + { + list_free(args); + result = NULL; + goto done; + } + } + result = apply(ctx, fn, args); } - } - result = apply(ctx, fn, args); } - } - break; + break; default: - ERR("unrecognized value, type %d, size %zu bytes", expr->type, expr->size); - DIE("we don't eval that around here!"); - } + ERR("unrecognized value, type %d, size %zu bytes", expr->type, + expr->size); + DIE("we don't eval that around here!"); + } - done: return result; +done: + return result; } LakeList *eval_exprs(LakeCtx *ctx, Env *env, LakeList *exprs) { - LakeList *results = list_make_with_capacity(LIST_N(exprs)); - int i; - for (i = 0; i < LIST_N(exprs); ++i) { - list_append(results, eval(ctx, env, LIST_VAL(exprs, i))); - } - return results; + LakeList *results = list_make_with_capacity(LIST_N(exprs)); + int i; + for (i = 0; i < LIST_N(exprs); ++i) + { + list_append(results, eval(ctx, env, LIST_VAL(exprs, i))); + } + return results; } LakeVal *eval_exprs1(LakeCtx *ctx, Env *env, LakeList *exprs) { - LakeList *results = eval_exprs(ctx, env, exprs); - LakeVal *result = list_pop(results); - list_free(results); - return result; + LakeList *results = eval_exprs(ctx, env, exprs); + LakeVal *result = list_pop(results); + list_free(results); + return result; } LakeVal *apply(LakeCtx *ctx, LakeVal *fnVal, LakeList *args) { - LakeVal *result = NULL; - if (lake_is_type(TYPE_PRIM, fnVal)) { - LakePrimitive *prim = PRIM(fnVal); - int arity = prim->arity; - if (arity == ARITY_VARARGS || LIST_N(args) == arity) { - result = prim->fn(ctx, args); + LakeVal *result = NULL; + if (lake_is_type(TYPE_PRIM, fnVal)) + { + LakePrimitive *prim = PRIM(fnVal); + int arity = prim->arity; + if (arity == ARITY_VARARGS || LIST_N(args) == arity) + { + result = prim->fn(ctx, args); + } + else + { + ERR("%s expects %d params but got %zu", prim->name, arity, + LIST_N(args)); + result = NULL; + } } - else { - ERR("%s expects %d params but got %zu", prim->name, arity, LIST_N(args)); - result = NULL; - } - } - else if (lake_is_type(TYPE_FN, fnVal)) { - LakeFn *fn = FN(fnVal); + else if (lake_is_type(TYPE_FN, fnVal)) + { + LakeFn *fn = FN(fnVal); - /* Check # of params */ - size_t nparams = LIST_N(fn->params); - if (!fn->varargs && LIST_N(args) != nparams) { - ERR("expected %zu params but got %zu", nparams, LIST_N(args)); - return NULL; - } - else if (fn->varargs && LIST_N(args) < nparams) { - ERR("expected at least %zu params but got %zu", nparams, LIST_N(args)); - return NULL; - } + /* Check # of params */ + size_t nparams = LIST_N(fn->params); + if (!fn->varargs && LIST_N(args) != nparams) + { + ERR("expected %zu params but got %zu", nparams, LIST_N(args)); + return NULL; + } + else if (fn->varargs && LIST_N(args) < nparams) + { + ERR("expected at least %zu params but got %zu", nparams, + LIST_N(args)); + return NULL; + } - Env *env = env_make(fn->closure); + Env *env = env_make(fn->closure); - /* bind each (param,arg) pair in env */ - size_t i; - for (i = 0; i < nparams; ++i) { - env_define(env, SYM(LIST_VAL(fn->params, i)), LIST_VAL(args, i)); + /* bind each (param,arg) pair in env */ + size_t i; + for (i = 0; i < nparams; ++i) + { + env_define(env, SYM(LIST_VAL(fn->params, i)), LIST_VAL(args, i)); + } + + /* bind varargs */ + if (fn->varargs) + { + LakeList *remainingArgs = + list_make_with_capacity(LIST_N(args) - nparams); + for (; i < LIST_N(args); ++i) + { + list_append(remainingArgs, LIST_VAL(args, i)); + } + env_define(env, fn->varargs, VAL(remainingArgs)); + } + + /* evaluate body */ + result = eval_exprs1(ctx, env, fn->body); } - - /* bind varargs */ - if (fn->varargs) { - LakeList *remainingArgs = list_make_with_capacity(LIST_N(args) - nparams); - for (; i < LIST_N(args); ++i) { - list_append(remainingArgs, LIST_VAL(args, i)); - } - env_define(env, fn->varargs, VAL(remainingArgs)); + else + { + ERR("not a function: %s", lake_repr(fnVal)); } - - /* evaluate body */ - result = eval_exprs1(ctx, env, fn->body); - } - else { - ERR("not a function: %s", lake_repr(fnVal)); - } - return result; + return result; } diff --git a/src/eval.h b/src/eval.h index 26f59b8..63f19eb 100644 --- a/src/eval.h +++ b/src/eval.h @@ -1,11 +1,11 @@ -/** - * eval.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * eval.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_EVAL_H #define _LAKE_EVAL_H diff --git a/src/fn.c b/src/fn.c index eb6dbfb..b018f3e 100644 --- a/src/fn.c +++ b/src/fn.c @@ -1,65 +1,70 @@ -/** - * fn.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * fn.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include +#include "fn.h" #include "common.h" #include "env.h" -#include "fn.h" #include "lake.h" +#include static LakeFn *fn_alloc(void) { - LakeFn *fn = malloc(sizeof(LakeFn)); - VAL(fn)->type = TYPE_FN; - VAL(fn)->size = sizeof(LakeFn); - return fn; + LakeFn *fn = malloc(sizeof(LakeFn)); + VAL(fn)->type = TYPE_FN; + VAL(fn)->size = sizeof(LakeFn); + return fn; } -LakeFn *fn_make(LakeList *params, LakeSym *varargs, LakeList *body, Env *closure) +LakeFn *fn_make(LakeList *params, LakeSym *varargs, LakeList *body, + Env *closure) { - LakeFn *fn = fn_alloc(); - fn->params = params; - fn->varargs = varargs; - fn->body = body; - fn->closure = closure; - return fn; + LakeFn *fn = fn_alloc(); + fn->params = params; + fn->varargs = varargs; + fn->body = body; + fn->closure = closure; + return fn; } char *fn_repr(LakeFn *fn) { - char *s = malloc(8); - s[0] = '\0'; - s = lake_str_append(s, "(lambda "); - char *s2; - if (LIST_N(fn->params) && fn->varargs) { - LakeDottedList *params = dlist_make(fn->params, VAL(fn->varargs)); - s2 = dlist_repr(params); - s = lake_str_append(s, s2); - free(s2); - } - else if (fn->varargs) { - s2 = lake_repr(fn->varargs); - s = lake_str_append(s, s2); - free(s2); - } - else { - s2 = lake_repr(fn->params); - s = lake_str_append(s, s2); - free(s2); - } - s = lake_str_append(s, " "); - int i; - for (i = 0; i < LIST_N(fn->body); ++i) { - s2 = lake_repr(LIST_VAL(fn->body, i)); - s = lake_str_append(s, s2); - free(s2); - if (i != LIST_N(fn->body) - 1) s = lake_str_append(s, " "); - } - return lake_str_append(s, ")"); + char *s = malloc(8); + s[0] = '\0'; + s = lake_str_append(s, "(lambda "); + char *s2; + if (LIST_N(fn->params) && fn->varargs) + { + LakeDottedList *params = dlist_make(fn->params, VAL(fn->varargs)); + s2 = dlist_repr(params); + s = lake_str_append(s, s2); + free(s2); + } + else if (fn->varargs) + { + s2 = lake_repr(fn->varargs); + s = lake_str_append(s, s2); + free(s2); + } + else + { + s2 = lake_repr(fn->params); + s = lake_str_append(s, s2); + free(s2); + } + s = lake_str_append(s, " "); + int i; + for (i = 0; i < LIST_N(fn->body); ++i) + { + s2 = lake_repr(LIST_VAL(fn->body, i)); + s = lake_str_append(s, s2); + free(s2); + if (i != LIST_N(fn->body) - 1) s = lake_str_append(s, " "); + } + return lake_str_append(s, ")"); } diff --git a/src/fn.h b/src/fn.h index 5490a5f..4fd05bd 100644 --- a/src/fn.h +++ b/src/fn.h @@ -1,11 +1,11 @@ -/** - * fn.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * fn.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_FN_H #define _LAKE_FN_H @@ -13,7 +13,8 @@ #include "env.h" #include "lake.h" -LakeFn *fn_make(LakeList *params, LakeSym *varargs, LakeList *body, Env *closure); +LakeFn *fn_make(LakeList *params, LakeSym *varargs, LakeList *body, + Env *closure); char *fn_repr(LakeFn *fn); #endif \ No newline at end of file diff --git a/src/hash.c b/src/hash.c index 6029d7e..afec2a4 100644 --- a/src/hash.c +++ b/src/hash.c @@ -1,29 +1,32 @@ /** - * hash.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - * Lifted from TJ Holowaychuk's Luna. - * https://raw.github.com/visionmedia/luna - * - */ + * hash.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + * Lifted from TJ Holowaychuk's Luna. + * https://raw.github.com/visionmedia/luna + * + */ #include "hash.h" -void lake_hash_put(khash_t(value) *h, char *key, void *val) { - int ret; - khiter_t k = kh_put(value, h, key, &ret); - kh_value(h, k) = val; +void lake_hash_put(khash_t(value) * h, char *key, void *val) +{ + int ret; + khiter_t k = kh_put(value, h, key, &ret); + kh_value(h, k) = val; } -void *lake_hash_get(khash_t(value) *h, char *key) { - khiter_t k = kh_get(value, h, key); - return k == kh_end(h) ? NULL : kh_value(h, k); +void *lake_hash_get(khash_t(value) * h, char *key) +{ + khiter_t k = kh_get(value, h, key); + return k == kh_end(h) ? NULL : kh_value(h, k); } -bool lake_hash_has(khash_t(value) *h, char *key) { - khiter_t k = kh_get(value, h, key); - return kh_exist(h, k); +bool lake_hash_has(khash_t(value) * h, char *key) +{ + khiter_t k = kh_get(value, h, key); + return kh_exist(h, k); } diff --git a/src/hash.h b/src/hash.h index d5a00eb..7553007 100644 --- a/src/hash.h +++ b/src/hash.h @@ -1,20 +1,20 @@ /** - * hash.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - * Lifted from TJ Holowaychuk's Luna. - * https://raw.github.com/visionmedia/luna - * - */ + * hash.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + * Lifted from TJ Holowaychuk's Luna. + * https://raw.github.com/visionmedia/luna + * + */ #ifndef _LAKE_HASH_H #define _LAKE_HASH_H -#include "khash.h" #include "common.h" +#include "khash.h" KHASH_MAP_INIT_STR(value, void *); @@ -23,8 +23,8 @@ typedef khash_t(value) lake_hash_t; #define lake_hash_make() kh_init(value) #define lake_hash_free(h) kh_destroy(value, h) -bool lake_hash_has(khash_t(value) *h, char *key); -void lake_hash_put(khash_t(value) *h, char *key, void *val); -void *lake_hash_get(khash_t(value) *h, char *key); +bool lake_hash_has(khash_t(value) * h, char *key); +void lake_hash_put(khash_t(value) * h, char *key, void *val); +void *lake_hash_get(khash_t(value) * h, char *key); #endif diff --git a/src/int.c b/src/int.c index e06dc3c..c8d0560 100644 --- a/src/int.c +++ b/src/int.c @@ -1,49 +1,46 @@ -/** - * int.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * int.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include "common.h" #include "int.h" +#include "common.h" #include "lake.h" #include "str.h" +#include static LakeInt *int_alloc(void) { - LakeInt *i = malloc(sizeof(LakeInt)); - VAL(i)->type = TYPE_INT; - VAL(i)->size = sizeof(LakeInt); - return i; + LakeInt *i = malloc(sizeof(LakeInt)); + VAL(i)->type = TYPE_INT; + VAL(i)->size = sizeof(LakeInt); + return i; } -LakeInt *int_make(void) -{ - return int_from_c(0); -} +LakeInt *int_make(void) { return int_from_c(0); } LakeInt *int_from_c(int n) { - LakeInt *i = int_alloc(); - i->val = n; - return i; + LakeInt *i = int_alloc(); + i->val = n; + return i; } char *int_repr(LakeInt *i) { - char *s = malloc(MAX_INT_LENGTH + 1); - snprintf(s, MAX_INT_LENGTH, "%d", i->val); - return s; + char *s = malloc(MAX_INT_LENGTH + 1); + snprintf(s, MAX_INT_LENGTH, "%d", i->val); + return s; } LakeStr *int_to_str(LakeInt *i) { - char *s = int_repr(i); - LakeStr *str = lake_str_from_c(s); - free(s); - return str; + char *s = int_repr(i); + LakeStr *str = lake_str_from_c(s); + free(s); + return str; } diff --git a/src/int.h b/src/int.h index 0c0e6b7..94c8d6d 100644 --- a/src/int.h +++ b/src/int.h @@ -1,11 +1,11 @@ -/** - * int.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * int.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_INT_H #define _LAKE_INT_H diff --git a/src/khash.h b/src/khash.h index 8cbc98c..fdc7317 100644 --- a/src/khash.h +++ b/src/khash.h @@ -29,38 +29,38 @@ #include "khash.h" KHASH_MAP_INIT_INT(32, char) int main() { - int ret, is_missing; - khiter_t k; - khash_t(32) *h = kh_init(32); - k = kh_put(32, h, 5, &ret); - if (!ret) kh_del(32, h, k); - kh_value(h, k) = 10; - k = kh_get(32, h, 10); - is_missing = (k == kh_end(h)); - k = kh_get(32, h, 5); - kh_del(32, h, k); - for (k = kh_begin(h); k != kh_end(h); ++k) - if (kh_exist(h, k)) kh_value(h, k) = 1; - kh_destroy(32, h); - return 0; + int ret, is_missing; + khiter_t k; + khash_t(32) *h = kh_init(32); + k = kh_put(32, h, 5, &ret); + if (!ret) kh_del(32, h, k); + kh_value(h, k) = 10; + k = kh_get(32, h, 10); + is_missing = (k == kh_end(h)); + k = kh_get(32, h, 5); + kh_del(32, h, k); + for (k = kh_begin(h); k != kh_end(h); ++k) + if (kh_exist(h, k)) kh_value(h, k) = 1; + kh_destroy(32, h); + return 0; } */ /* 2011-09-16 (0.2.6): - * The capacity is a power of 2. This seems to dramatically improve the - speed for simple keys. Thank Zilong Tan for the suggestion. Reference: + * The capacity is a power of 2. This seems to dramatically improve the + speed for simple keys. Thank Zilong Tan for the suggestion. Reference: - - http://code.google.com/p/ulib/ - - http://nothings.org/computer/judy/ + - http://code.google.com/p/ulib/ + - http://nothings.org/computer/judy/ - * Allow to optionally use linear probing which usually has better - performance for random input. Double hashing is still the default as it - is more robust to certain non-random input. + * Allow to optionally use linear probing which usually has better + performance for random input. Double hashing is still the default as it + is more robust to certain non-random input. - * Added Wang's integer hash function (not used by default). This hash - function is more robust to certain non-random input. + * Added Wang's integer hash function (not used by default). This hash + function is more robust to certain non-random input. 2011-02-14 (0.2.5): @@ -72,32 +72,31 @@ int main() { 2008-09-19 (0.2.3): - * Corrected the example - * Improved interfaces + * Corrected the example + * Improved interfaces 2008-09-11 (0.2.2): - * Improved speed a little in kh_put() + * Improved speed a little in kh_put() 2008-09-10 (0.2.1): - * Added kh_clear() - * Fixed a compiling error + * Added kh_clear() + * Fixed a compiling error 2008-09-02 (0.2.0): - * Changed to token concatenation which increases flexibility. + * Changed to token concatenation which increases flexibility. 2008-08-31 (0.1.2): - * Fixed a bug in kh_get(), which has not been tested previously. + * Fixed a bug in kh_get(), which has not been tested previously. 2008-08-31 (0.1.1): - * Added destructor + * Added destructor */ - #ifndef __AC_KHASH_H #define __AC_KHASH_H @@ -109,9 +108,9 @@ int main() { #define AC_VERSION_KHASH_H "0.2.6" +#include #include #include -#include /* compipler specific configuration */ @@ -134,185 +133,269 @@ typedef unsigned long long khint64_t; typedef khint32_t khint_t; typedef khint_t khiter_t; -#define __ac_isempty(flag, i) ((flag[i>>4]>>((i&0xfU)<<1))&2) -#define __ac_isdel(flag, i) ((flag[i>>4]>>((i&0xfU)<<1))&1) -#define __ac_iseither(flag, i) ((flag[i>>4]>>((i&0xfU)<<1))&3) -#define __ac_set_isdel_false(flag, i) (flag[i>>4]&=~(1ul<<((i&0xfU)<<1))) -#define __ac_set_isempty_false(flag, i) (flag[i>>4]&=~(2ul<<((i&0xfU)<<1))) -#define __ac_set_isboth_false(flag, i) (flag[i>>4]&=~(3ul<<((i&0xfU)<<1))) -#define __ac_set_isdel_true(flag, i) (flag[i>>4]|=1ul<<((i&0xfU)<<1)) +#define __ac_isempty(flag, i) ((flag[i >> 4] >> ((i & 0xfU) << 1)) & 2) +#define __ac_isdel(flag, i) ((flag[i >> 4] >> ((i & 0xfU) << 1)) & 1) +#define __ac_iseither(flag, i) ((flag[i >> 4] >> ((i & 0xfU) << 1)) & 3) +#define __ac_set_isdel_false(flag, i) \ + (flag[i >> 4] &= ~(1ul << ((i & 0xfU) << 1))) +#define __ac_set_isempty_false(flag, i) \ + (flag[i >> 4] &= ~(2ul << ((i & 0xfU) << 1))) +#define __ac_set_isboth_false(flag, i) \ + (flag[i >> 4] &= ~(3ul << ((i & 0xfU) << 1))) +#define __ac_set_isdel_true(flag, i) (flag[i >> 4] |= 1ul << ((i & 0xfU) << 1)) #ifdef KHASH_LINEAR #define __ac_inc(k, m) 1 #else -#define __ac_inc(k, m) (((k)>>3 ^ (k)<<3) | 1) & (m) +#define __ac_inc(k, m) (((k) >> 3 ^ (k) << 3) | 1) & (m) #endif -#define __ac_fsize(m) ((m) < 16? 1 : (m)>>4) +#define __ac_fsize(m) ((m) < 16 ? 1 : (m) >> 4) #ifndef kroundup32 -#define kroundup32(x) (--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x)) +#define kroundup32(x) \ + (--(x), (x) |= (x) >> 1, (x) |= (x) >> 2, (x) |= (x) >> 4, \ + (x) |= (x) >> 8, (x) |= (x) >> 16, ++(x)) #endif static const double __ac_HASH_UPPER = 0.77; -#define KHASH_DECLARE(name, khkey_t, khval_t) \ - typedef struct { \ - khint_t n_buckets, size, n_occupied, upper_bound; \ - khint32_t *flags; \ - khkey_t *keys; \ - khval_t *vals; \ - } kh_##name##_t; \ - extern kh_##name##_t *kh_init_##name(); \ - extern void kh_destroy_##name(kh_##name##_t *h); \ - extern void kh_clear_##name(kh_##name##_t *h); \ - extern khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key); \ - extern void kh_resize_##name(kh_##name##_t *h, khint_t new_n_buckets); \ - extern khint_t kh_put_##name(kh_##name##_t *h, khkey_t key, int *ret); \ - extern void kh_del_##name(kh_##name##_t *h, khint_t x); +#define KHASH_DECLARE(name, khkey_t, khval_t) \ + typedef struct \ + { \ + khint_t n_buckets, size, n_occupied, upper_bound; \ + khint32_t *flags; \ + khkey_t *keys; \ + khval_t *vals; \ + } kh_##name##_t; \ + extern kh_##name##_t *kh_init_##name(); \ + extern void kh_destroy_##name(kh_##name##_t *h); \ + extern void kh_clear_##name(kh_##name##_t *h); \ + extern khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key); \ + extern void kh_resize_##name(kh_##name##_t *h, khint_t new_n_buckets); \ + extern khint_t kh_put_##name(kh_##name##_t *h, khkey_t key, int *ret); \ + extern void kh_del_##name(kh_##name##_t *h, khint_t x); -#define KHASH_INIT2(name, SCOPE, khkey_t, khval_t, kh_is_map, __hash_func, __hash_equal) \ - typedef struct { \ - khint_t n_buckets, size, n_occupied, upper_bound; \ - khint32_t *flags; \ - khkey_t *keys; \ - khval_t *vals; \ - } kh_##name##_t; \ - SCOPE kh_##name##_t *kh_init_##name() { \ - return (kh_##name##_t*)calloc(1, sizeof(kh_##name##_t)); \ - } \ - SCOPE void kh_destroy_##name(kh_##name##_t *h) \ - { \ - if (h) { \ - free(h->keys); free(h->flags); \ - free(h->vals); \ - free(h); \ - } \ - } \ - SCOPE void kh_clear_##name(kh_##name##_t *h) \ - { \ - if (h && h->flags) { \ - memset(h->flags, 0xaa, __ac_fsize(h->n_buckets) * sizeof(khint32_t)); \ - h->size = h->n_occupied = 0; \ - } \ - } \ - SCOPE khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key) \ - { \ - if (h->n_buckets) { \ - khint_t inc, k, i, last, mask; \ - mask = h->n_buckets - 1; \ - k = __hash_func(key); i = k & mask; \ - inc = __ac_inc(k, mask); last = i; /* inc==1 for linear probing */ \ - while (!__ac_isempty(h->flags, i) && (__ac_isdel(h->flags, i) || !__hash_equal(h->keys[i], key))) { \ - i = (i + inc) & mask; \ - if (i == last) return h->n_buckets; \ - } \ - return __ac_iseither(h->flags, i)? h->n_buckets : i; \ - } else return 0; \ - } \ - SCOPE void kh_resize_##name(kh_##name##_t *h, khint_t new_n_buckets) \ - { /* This function uses 0.25*n_bucktes bytes of working space instead of [sizeof(key_t+val_t)+.25]*n_buckets. */ \ - khint32_t *new_flags = 0; \ - khint_t j = 1; \ - { \ - kroundup32(new_n_buckets); \ - if (new_n_buckets < 4) new_n_buckets = 4; \ - if (h->size >= (khint_t)(new_n_buckets * __ac_HASH_UPPER + 0.5)) j = 0; /* requested size is too small */ \ - else { /* hash table size to be changed (shrink or expand); rehash */ \ - new_flags = (khint32_t*)malloc(__ac_fsize(new_n_buckets) * sizeof(khint32_t)); \ - memset(new_flags, 0xaa, __ac_fsize(new_n_buckets) * sizeof(khint32_t)); \ - if (h->n_buckets < new_n_buckets) { /* expand */ \ - h->keys = (khkey_t*)realloc(h->keys, new_n_buckets * sizeof(khkey_t)); \ - if (kh_is_map) h->vals = (khval_t*)realloc(h->vals, new_n_buckets * sizeof(khval_t)); \ - } /* otherwise shrink */ \ - } \ - } \ - if (j) { /* rehashing is needed */ \ - for (j = 0; j != h->n_buckets; ++j) { \ - if (__ac_iseither(h->flags, j) == 0) { \ - khkey_t key = h->keys[j]; \ - khval_t val; \ - khint_t new_mask; \ - new_mask = new_n_buckets - 1; \ - if (kh_is_map) val = h->vals[j]; \ - __ac_set_isdel_true(h->flags, j); \ - while (1) { /* kick-out process; sort of like in Cuckoo hashing */ \ - khint_t inc, k, i; \ - k = __hash_func(key); \ - i = k & new_mask; \ - inc = __ac_inc(k, new_mask); \ - while (!__ac_isempty(new_flags, i)) i = (i + inc) & new_mask; \ - __ac_set_isempty_false(new_flags, i); \ - if (i < h->n_buckets && __ac_iseither(h->flags, i) == 0) { /* kick out the existing element */ \ - { khkey_t tmp = h->keys[i]; h->keys[i] = key; key = tmp; } \ - if (kh_is_map) { khval_t tmp = h->vals[i]; h->vals[i] = val; val = tmp; } \ - __ac_set_isdel_true(h->flags, i); /* mark it as deleted in the old hash table */ \ - } else { /* write the element and jump out of the loop */ \ - h->keys[i] = key; \ - if (kh_is_map) h->vals[i] = val; \ - break; \ - } \ - } \ - } \ - } \ - if (h->n_buckets > new_n_buckets) { /* shrink the hash table */ \ - h->keys = (khkey_t*)realloc(h->keys, new_n_buckets * sizeof(khkey_t)); \ - if (kh_is_map) h->vals = (khval_t*)realloc(h->vals, new_n_buckets * sizeof(khval_t)); \ - } \ - free(h->flags); /* free the working space */ \ - h->flags = new_flags; \ - h->n_buckets = new_n_buckets; \ - h->n_occupied = h->size; \ - h->upper_bound = (khint_t)(h->n_buckets * __ac_HASH_UPPER + 0.5); \ - } \ - } \ - SCOPE khint_t kh_put_##name(kh_##name##_t *h, khkey_t key, int *ret) \ - { \ - khint_t x; \ - if (h->n_occupied >= h->upper_bound) { /* update the hash table */ \ - if (h->n_buckets > (h->size<<1)) kh_resize_##name(h, h->n_buckets - 1); /* clear "deleted" elements */ \ - else kh_resize_##name(h, h->n_buckets + 1); /* expand the hash table */ \ - } /* TODO: to implement automatically shrinking; resize() already support shrinking */ \ - { \ - khint_t inc, k, i, site, last, mask = h->n_buckets - 1; \ - x = site = h->n_buckets; k = __hash_func(key); i = k & mask; \ - if (__ac_isempty(h->flags, i)) x = i; /* for speed up */ \ - else { \ - inc = __ac_inc(k, mask); last = i; \ - while (!__ac_isempty(h->flags, i) && (__ac_isdel(h->flags, i) || !__hash_equal(h->keys[i], key))) { \ - if (__ac_isdel(h->flags, i)) site = i; \ - i = (i + inc) & mask; \ - if (i == last) { x = site; break; } \ - } \ - if (x == h->n_buckets) { \ - if (__ac_isempty(h->flags, i) && site != h->n_buckets) x = site; \ - else x = i; \ - } \ - } \ - } \ - if (__ac_isempty(h->flags, x)) { /* not present at all */ \ - h->keys[x] = key; \ - __ac_set_isboth_false(h->flags, x); \ - ++h->size; ++h->n_occupied; \ - *ret = 1; \ - } else if (__ac_isdel(h->flags, x)) { /* deleted */ \ - h->keys[x] = key; \ - __ac_set_isboth_false(h->flags, x); \ - ++h->size; \ - *ret = 2; \ - } else *ret = 0; /* Don't touch h->keys[x] if present and not deleted */ \ - return x; \ - } \ - SCOPE void kh_del_##name(kh_##name##_t *h, khint_t x) \ - { \ - if (x != h->n_buckets && !__ac_iseither(h->flags, x)) { \ - __ac_set_isdel_true(h->flags, x); \ - --h->size; \ - } \ - } +#define KHASH_INIT2(name, SCOPE, khkey_t, khval_t, kh_is_map, __hash_func, \ + __hash_equal) \ + typedef struct \ + { \ + khint_t n_buckets, size, n_occupied, upper_bound; \ + khint32_t *flags; \ + khkey_t *keys; \ + khval_t *vals; \ + } kh_##name##_t; \ + SCOPE kh_##name##_t *kh_init_##name() \ + { \ + return (kh_##name##_t *)calloc(1, sizeof(kh_##name##_t)); \ + } \ + SCOPE void kh_destroy_##name(kh_##name##_t *h) \ + { \ + if (h) \ + { \ + free(h->keys); \ + free(h->flags); \ + free(h->vals); \ + free(h); \ + } \ + } \ + SCOPE void kh_clear_##name(kh_##name##_t *h) \ + { \ + if (h && h->flags) \ + { \ + memset(h->flags, 0xaa, \ + __ac_fsize(h->n_buckets) * sizeof(khint32_t)); \ + h->size = h->n_occupied = 0; \ + } \ + } \ + SCOPE khint_t kh_get_##name(const kh_##name##_t *h, khkey_t key) \ + { \ + if (h->n_buckets) \ + { \ + khint_t inc, k, i, last, mask; \ + mask = h->n_buckets - 1; \ + k = __hash_func(key); \ + i = k & mask; \ + inc = __ac_inc(k, mask); \ + last = i; /* inc==1 for linear probing */ \ + while ( \ + !__ac_isempty(h->flags, i) && \ + (__ac_isdel(h->flags, i) || !__hash_equal(h->keys[i], key))) \ + { \ + i = (i + inc) & mask; \ + if (i == last) return h->n_buckets; \ + } \ + return __ac_iseither(h->flags, i) ? h->n_buckets : i; \ + } \ + else \ + return 0; \ + } \ + SCOPE void kh_resize_##name(kh_##name##_t *h, khint_t new_n_buckets) \ + { /* This function uses 0.25*n_bucktes bytes of working space instead of \ + [sizeof(key_t+val_t)+.25]*n_buckets. */ \ + khint32_t *new_flags = 0; \ + khint_t j = 1; \ + { \ + kroundup32(new_n_buckets); \ + if (new_n_buckets < 4) new_n_buckets = 4; \ + if (h->size >= (khint_t)(new_n_buckets * __ac_HASH_UPPER + 0.5)) \ + j = 0; /* requested size is too small */ \ + else \ + { /* hash table size to be changed (shrink or expand); rehash */ \ + new_flags = (khint32_t *)malloc(__ac_fsize(new_n_buckets) * \ + sizeof(khint32_t)); \ + memset(new_flags, 0xaa, \ + __ac_fsize(new_n_buckets) * sizeof(khint32_t)); \ + if (h->n_buckets < new_n_buckets) \ + { /* expand */ \ + h->keys = (khkey_t *)realloc( \ + h->keys, new_n_buckets * sizeof(khkey_t)); \ + if (kh_is_map) \ + h->vals = (khval_t *)realloc( \ + h->vals, new_n_buckets * sizeof(khval_t)); \ + } /* otherwise shrink */ \ + } \ + } \ + if (j) \ + { /* rehashing is needed */ \ + for (j = 0; j != h->n_buckets; ++j) \ + { \ + if (__ac_iseither(h->flags, j) == 0) \ + { \ + khkey_t key = h->keys[j]; \ + khval_t val; \ + khint_t new_mask; \ + new_mask = new_n_buckets - 1; \ + if (kh_is_map) val = h->vals[j]; \ + __ac_set_isdel_true(h->flags, j); \ + while (1) \ + { /* kick-out process; sort of like in Cuckoo hashing */ \ + khint_t inc, k, i; \ + k = __hash_func(key); \ + i = k & new_mask; \ + inc = __ac_inc(k, new_mask); \ + while (!__ac_isempty(new_flags, i)) \ + i = (i + inc) & new_mask; \ + __ac_set_isempty_false(new_flags, i); \ + if (i < h->n_buckets && \ + __ac_iseither(h->flags, i) == 0) \ + { /* kick out the existing element */ \ + { \ + khkey_t tmp = h->keys[i]; \ + h->keys[i] = key; \ + key = tmp; \ + } \ + if (kh_is_map) \ + { \ + khval_t tmp = h->vals[i]; \ + h->vals[i] = val; \ + val = tmp; \ + } \ + __ac_set_isdel_true(h->flags, \ + i); /* mark it as deleted in \ + the old hash table */ \ + } \ + else \ + { /* write the element and jump out of the loop */ \ + h->keys[i] = key; \ + if (kh_is_map) h->vals[i] = val; \ + break; \ + } \ + } \ + } \ + } \ + if (h->n_buckets > new_n_buckets) \ + { /* shrink the hash table */ \ + h->keys = (khkey_t *)realloc(h->keys, \ + new_n_buckets * sizeof(khkey_t)); \ + if (kh_is_map) \ + h->vals = (khval_t *)realloc( \ + h->vals, new_n_buckets * sizeof(khval_t)); \ + } \ + free(h->flags); /* free the working space */ \ + h->flags = new_flags; \ + h->n_buckets = new_n_buckets; \ + h->n_occupied = h->size; \ + h->upper_bound = (khint_t)(h->n_buckets * __ac_HASH_UPPER + 0.5); \ + } \ + } \ + SCOPE khint_t kh_put_##name(kh_##name##_t *h, khkey_t key, int *ret) \ + { \ + khint_t x; \ + if (h->n_occupied >= h->upper_bound) \ + { /* update the hash table */ \ + if (h->n_buckets > (h->size << 1)) \ + kh_resize_##name(h, h->n_buckets - \ + 1); /* clear "deleted" elements */ \ + else \ + kh_resize_##name(h, h->n_buckets + \ + 1); /* expand the hash table */ \ + } /* TODO: to implement automatically shrinking; resize() already \ + support shrinking */ \ + { \ + khint_t inc, k, i, site, last, mask = h->n_buckets - 1; \ + x = site = h->n_buckets; \ + k = __hash_func(key); \ + i = k & mask; \ + if (__ac_isempty(h->flags, i)) \ + x = i; /* for speed up */ \ + else \ + { \ + inc = __ac_inc(k, mask); \ + last = i; \ + while (!__ac_isempty(h->flags, i) && \ + (__ac_isdel(h->flags, i) || \ + !__hash_equal(h->keys[i], key))) \ + { \ + if (__ac_isdel(h->flags, i)) site = i; \ + i = (i + inc) & mask; \ + if (i == last) \ + { \ + x = site; \ + break; \ + } \ + } \ + if (x == h->n_buckets) \ + { \ + if (__ac_isempty(h->flags, i) && site != h->n_buckets) \ + x = site; \ + else \ + x = i; \ + } \ + } \ + } \ + if (__ac_isempty(h->flags, x)) \ + { /* not present at all */ \ + h->keys[x] = key; \ + __ac_set_isboth_false(h->flags, x); \ + ++h->size; \ + ++h->n_occupied; \ + *ret = 1; \ + } \ + else if (__ac_isdel(h->flags, x)) \ + { /* deleted */ \ + h->keys[x] = key; \ + __ac_set_isboth_false(h->flags, x); \ + ++h->size; \ + *ret = 2; \ + } \ + else \ + *ret = 0; /* Don't touch h->keys[x] if present and not deleted */ \ + return x; \ + } \ + SCOPE void kh_del_##name(kh_##name##_t *h, khint_t x) \ + { \ + if (x != h->n_buckets && !__ac_iseither(h->flags, x)) \ + { \ + __ac_set_isdel_true(h->flags, x); \ + --h->size; \ + } \ + } -#define KHASH_INIT(name, khkey_t, khval_t, kh_is_map, __hash_func, __hash_equal) \ - KHASH_INIT2(name, static inline, khkey_t, khval_t, kh_is_map, __hash_func, __hash_equal) +#define KHASH_INIT(name, khkey_t, khval_t, kh_is_map, __hash_func, \ + __hash_equal) \ + KHASH_INIT2(name, static inline, khkey_t, khval_t, kh_is_map, __hash_func, \ + __hash_equal) /* --- BEGIN OF HASH FUNCTIONS --- */ @@ -331,7 +414,7 @@ static const double __ac_HASH_UPPER = 0.77; @param key The integer [khint64_t] @return The hash value [khint_t] */ -#define kh_int64_hash_func(key) (khint32_t)((key)>>33^(key)^(key)<<11) +#define kh_int64_hash_func(key) (khint32_t)((key) >> 33 ^ (key) ^ (key) << 11) /*! @function @abstract 64-bit integer comparison function */ @@ -343,9 +426,11 @@ static const double __ac_HASH_UPPER = 0.77; */ static inline khint_t __ac_X31_hash_string(const char *s) { - khint_t h = *s; - if (h) for (++s ; *s; ++s) h = (h << 5) - h + *s; - return h; + khint_t h = *s; + if (h) + for (++s; *s; ++s) + h = (h << 5) - h + *s; + return h; } /*! @function @abstract Another interface to const char* hash function @@ -361,11 +446,11 @@ static inline khint_t __ac_X31_hash_string(const char *s) static inline khint_t __ac_Wang_hash(khint_t key) { key += ~(key << 15); - key ^= (key >> 10); - key += (key << 3); - key ^= (key >> 6); + key ^= (key >> 10); + key += (key << 3); + key ^= (key >> 6); key += ~(key << 11); - key ^= (key >> 16); + key ^= (key >> 16); return key; } #define kh_int_hash_func2(k) __ac_Wang_hash((khint_t)key) @@ -416,7 +501,7 @@ static inline khint_t __ac_Wang_hash(khint_t key) @param k Key [type of keys] @param r Extra return code: 0 if the key is present in the hash table; 1 if the bucket is empty (never used); 2 if the element in - the bucket has been deleted [int*] + the bucket has been deleted [int*] @return Iterator to the inserted element [khint_t] */ #define kh_put(name, h, k, r) kh_put_##name(h, k, r) @@ -426,7 +511,8 @@ static inline khint_t __ac_Wang_hash(khint_t key) @param name Name of the hash table [symbol] @param h Pointer to the hash table [khash_t(name)*] @param k Key [type of keys] - @return Iterator to the found element, or kh_end(h) is the element is absent [khint_t] + @return Iterator to the found element, or kh_end(h) is the element is + absent [khint_t] */ #define kh_get(name, h, k) kh_get_##name(h, k) @@ -502,46 +588,48 @@ static inline khint_t __ac_Wang_hash(khint_t key) @abstract Instantiate a hash set containing integer keys @param name Name of the hash table [symbol] */ -#define KHASH_SET_INIT_INT(name) \ - KHASH_INIT(name, khint32_t, char, 0, kh_int_hash_func, kh_int_hash_equal) +#define KHASH_SET_INIT_INT(name) \ + KHASH_INIT(name, khint32_t, char, 0, kh_int_hash_func, kh_int_hash_equal) /*! @function @abstract Instantiate a hash map containing integer keys @param name Name of the hash table [symbol] @param khval_t Type of values [type] */ -#define KHASH_MAP_INIT_INT(name, khval_t) \ - KHASH_INIT(name, khint32_t, khval_t, 1, kh_int_hash_func, kh_int_hash_equal) +#define KHASH_MAP_INIT_INT(name, khval_t) \ + KHASH_INIT(name, khint32_t, khval_t, 1, kh_int_hash_func, kh_int_hash_equal) /*! @function @abstract Instantiate a hash map containing 64-bit integer keys @param name Name of the hash table [symbol] */ -#define KHASH_SET_INIT_INT64(name) \ - KHASH_INIT(name, khint64_t, char, 0, kh_int64_hash_func, kh_int64_hash_equal) +#define KHASH_SET_INIT_INT64(name) \ + KHASH_INIT(name, khint64_t, char, 0, kh_int64_hash_func, \ + kh_int64_hash_equal) /*! @function @abstract Instantiate a hash map containing 64-bit integer keys @param name Name of the hash table [symbol] @param khval_t Type of values [type] */ -#define KHASH_MAP_INIT_INT64(name, khval_t) \ - KHASH_INIT(name, khint64_t, khval_t, 1, kh_int64_hash_func, kh_int64_hash_equal) +#define KHASH_MAP_INIT_INT64(name, khval_t) \ + KHASH_INIT(name, khint64_t, khval_t, 1, kh_int64_hash_func, \ + kh_int64_hash_equal) typedef const char *kh_cstr_t; /*! @function @abstract Instantiate a hash map containing const char* keys @param name Name of the hash table [symbol] */ -#define KHASH_SET_INIT_STR(name) \ - KHASH_INIT(name, kh_cstr_t, char, 0, kh_str_hash_func, kh_str_hash_equal) +#define KHASH_SET_INIT_STR(name) \ + KHASH_INIT(name, kh_cstr_t, char, 0, kh_str_hash_func, kh_str_hash_equal) /*! @function @abstract Instantiate a hash map containing const char* keys @param name Name of the hash table [symbol] @param khval_t Type of values [type] */ -#define KHASH_MAP_INIT_STR(name, khval_t) \ - KHASH_INIT(name, kh_cstr_t, khval_t, 1, kh_str_hash_func, kh_str_hash_equal) +#define KHASH_MAP_INIT_STR(name, khval_t) \ + KHASH_INIT(name, kh_cstr_t, khval_t, 1, kh_str_hash_func, kh_str_hash_equal) #endif /* __AC_KHASH_H */ \ No newline at end of file diff --git a/src/lake.c b/src/lake.c index 14369a3..aed2e4d 100644 --- a/src/lake.c +++ b/src/lake.c @@ -1,171 +1,169 @@ -/** - * lake.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - * A quick and dirty scheme written in C, for fun and to use while - * reading The Little Schemer. - * - */ +/** + * lake.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + * A quick and dirty scheme written in C, for fun and to use while + * reading The Little Schemer. + * + */ +#include "lake.h" #include "bool.h" #include "comment.h" #include "common.h" -#include "hash.h" #include "env.h" #include "eval.h" -#include "lake.h" +#include "hash.h" #include "list.h" #include "primitive.h" #include "str.h" -int lake_val_size(void *x) -{ - return VAL(x)->size; -} +int lake_val_size(void *x) { return VAL(x)->size; } -int lake_is_type(LakeType t, void *x) -{ - return VAL(x)->type == t; -} +int lake_is_type(LakeType t, void *x) { return VAL(x)->type == t; } char *lake_repr(void *expr) { - if (expr == NULL) return strdup("(null)"); + if (expr == NULL) return strdup("(null)"); - char *s = NULL; + char *s = NULL; - LakeVal *e = VAL(expr); - switch (e->type) { + LakeVal *e = VAL(expr); + switch (e->type) + { case TYPE_SYM: - s = sym_repr(SYM(e)); - break; + s = sym_repr(SYM(e)); + break; case TYPE_BOOL: - s = lake_bool_repr(BOOL(e)); - break; + s = lake_bool_repr(BOOL(e)); + break; case TYPE_INT: - s = int_repr(INT(e)); - break; + s = int_repr(INT(e)); + break; - case TYPE_STR: { + case TYPE_STR: + { size_t n = strlen(STR_S(STR(e))) + 2; s = malloc(n); - /* TODO: quote the string */ + /* TODO: quote the string */ snprintf(s, n, "\"%s\"", STR_S(STR(e))); break; - } + } case TYPE_LIST: - s = list_repr(LIST(e)); - break; + s = list_repr(LIST(e)); + break; case TYPE_DLIST: - s = dlist_repr(DLIST(e)); - break; + s = dlist_repr(DLIST(e)); + break; case TYPE_PRIM: - s = prim_repr(PRIM(e)); - break; + s = prim_repr(PRIM(e)); + break; case TYPE_FN: - s = fn_repr(FN(e)); - break; + s = fn_repr(FN(e)); + break; case TYPE_COMM: - s = comment_repr(COMM(e)); - break; + s = comment_repr(COMM(e)); + break; default: - // 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 = strdup("(unknown)"); - } + // 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 = strdup("(unknown)"); + } - return s; + return s; } bool lake_is_nil(LakeVal *x) { - return lake_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) { - if (lake_is_type(TYPE_INT, a) && lake_is_type(TYPE_INT, b)) { - return INT_VAL(INT(a)) == INT_VAL(INT(b)); - } - if (lake_is_nil(a) && lake_is_nil(b)) return TRUE; - return a == b; + if (lake_is_type(TYPE_INT, a) && lake_is_type(TYPE_INT, b)) + { + return INT_VAL(INT(a)) == INT_VAL(INT(b)); + } + if (lake_is_nil(a) && lake_is_nil(b)) return TRUE; + return a == b; } static char *type_name(LakeVal *expr) { - static char *type_names[9] = { "nil", "symbol", "boolean", "integer", "string", "list", - "dotted-list", "primitive", "function" - }; + static char *type_names[9] = {"nil", "symbol", "boolean", + "integer", "string", "list", + "dotted-list", "primitive", "function"}; - LakeType t = expr->type; - return t >= 0 && t <= 8 ? type_names[t] : "(not a LakeVal)"; + LakeType t = expr->type; + return t >= 0 && t <= 8 ? type_names[t] : "(not a LakeVal)"; } bool lake_equal(LakeVal *a, LakeVal *b) { - if (a->type != b->type) return FALSE; - switch (a->type) { + if (a->type != b->type) return FALSE; + switch (a->type) + { /* singletons can be compared directly */ case TYPE_SYM: case TYPE_BOOL: case TYPE_PRIM: case TYPE_FN: - return a == b; + return a == b; case TYPE_INT: - return INT_VAL(INT(a)) == INT_VAL(INT(b)); + return INT_VAL(INT(a)) == INT_VAL(INT(b)); case TYPE_STR: - return lake_str_equal(STR(a), STR(b)); + return lake_str_equal(STR(a), STR(b)); case TYPE_LIST: - return list_equal(LIST(a), LIST(b)); + return list_equal(LIST(a), LIST(b)); case TYPE_DLIST: - return dlist_equal(DLIST(a), DLIST(b)); + return dlist_equal(DLIST(a), DLIST(b)); case TYPE_COMM: - return comment_equal(COMM(a), COMM(b)); + return comment_equal(COMM(a), COMM(b)); default: - ERR("unknown type %d (%s)", a->type, type_name(a)); - return FALSE; - } + ERR("unknown type %d (%s)", a->type, type_name(a)); + return FALSE; + } } static LakeBool *bool_make(bool val) { - LakeBool *b = malloc(sizeof(LakeBool)); - VAL(b)->type = TYPE_BOOL; - VAL(b)->size = sizeof(LakeBool); - b->val = val; - return b; + LakeBool *b = malloc(sizeof(LakeBool)); + VAL(b)->type = TYPE_BOOL; + VAL(b)->size = sizeof(LakeBool); + b->val = val; + return b; } LakeCtx *lake_init(void) { - LakeCtx *ctx = malloc(sizeof(LakeCtx)); - ctx->toplevel = env_make(NULL); - ctx->symbols = lake_hash_make(); - ctx->special_form_handlers = lake_hash_make(); - ctx->T = bool_make(TRUE); - ctx->F = bool_make(FALSE); - bind_primitives(ctx); - init_special_form_handlers(ctx); - return ctx; + LakeCtx *ctx = malloc(sizeof(LakeCtx)); + ctx->toplevel = env_make(NULL); + ctx->symbols = lake_hash_make(); + ctx->special_form_handlers = lake_hash_make(); + ctx->T = bool_make(TRUE); + ctx->F = bool_make(FALSE); + bind_primitives(ctx); + init_special_form_handlers(ctx); + return ctx; } diff --git a/src/lake.h b/src/lake.h index 194d3e5..e75212c 100644 --- a/src/lake.h +++ b/src/lake.h @@ -1,31 +1,31 @@ /** - * lake.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * lake.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_LAKE_H #define _LAKE_LAKE_H -#include #include "common.h" +#include #define LAKE_VERSION "0.1" typedef int LakeType; -#define TYPE_SYM 1 -#define TYPE_BOOL 2 -#define TYPE_INT 3 -#define TYPE_STR 4 -#define TYPE_LIST 5 +#define TYPE_SYM 1 +#define TYPE_BOOL 2 +#define TYPE_INT 3 +#define TYPE_STR 4 +#define TYPE_LIST 5 #define TYPE_DLIST 6 -#define TYPE_PRIM 7 -#define TYPE_FN 8 -#define TYPE_COMM 9 +#define TYPE_PRIM 7 +#define TYPE_FN 8 +#define TYPE_COMM 9 #define VAL(x) ((LakeVal *)x) #define SYM(x) ((LakeSym *)x) @@ -38,49 +38,55 @@ typedef int LakeType; #define FN(x) ((LakeFn *)x) #define COMM(x) ((LakeComment *)x) -struct lake_val { - LakeType type; - size_t size; +struct lake_val +{ + LakeType type; + size_t size; }; typedef struct lake_val LakeVal; -struct lake_sym { - LakeVal base; - size_t n; - char *s; - unsigned long hash; +struct lake_sym +{ + LakeVal base; + size_t n; + char *s; + unsigned long hash; }; typedef struct lake_sym LakeSym; -struct lake_bool { - LakeVal base; - bool val; +struct lake_bool +{ + LakeVal base; + bool val; }; typedef struct lake_bool LakeBool; -struct lake_int { - LakeVal base; - int val; +struct lake_int +{ + LakeVal base; + int val; }; typedef struct lake_int LakeInt; #define INT_VAL(x) (x->val) -struct lake_str { - LakeVal base; - size_t n; - char *s; +struct lake_str +{ + LakeVal base; + size_t n; + char *s; }; typedef struct lake_str LakeStr; #define STR_N(str) (str->n) #define STR_S(str) (str->s) -struct lake_list { - LakeVal base; - size_t cap; - size_t n; - LakeVal **vals; +struct lake_list +{ + LakeVal base; + size_t cap; + size_t n; + LakeVal **vals; }; typedef struct lake_list LakeList; @@ -88,54 +94,58 @@ typedef struct lake_list LakeList; #define LIST_VALS(list) (list->vals) #define LIST_VAL(list, i) (i >= 0 && i < list->n ? list->vals[i] : NULL) -struct lake_dlist { - LakeVal base; - LakeList *head; - LakeVal *tail; +struct lake_dlist +{ + LakeVal base; + LakeList *head; + LakeVal *tail; }; typedef struct lake_dlist LakeDottedList; -#include "hash.h" #include "env.h" +#include "hash.h" /* Execution context */ -struct lake_ctx { - Env *toplevel; - lake_hash_t *symbols; - lake_hash_t *special_form_handlers; - LakeBool *T; - LakeBool *F; +struct lake_ctx +{ + Env *toplevel; + lake_hash_t *symbols; + lake_hash_t *special_form_handlers; + LakeBool *T; + LakeBool *F; }; typedef struct lake_ctx LakeCtx; typedef LakeVal *(*lake_prim)(LakeCtx *ctx, LakeList *args); -struct lake_primitive { - LakeVal base; - char *name; - int arity; - lake_prim fn; +struct lake_primitive +{ + LakeVal base; + char *name; + int arity; + lake_prim fn; }; typedef struct lake_primitive LakePrimitive; #define PRIM_ARITY(x) (x->arity) #define ARITY_VARARGS -1 - -struct lake_fn { - LakeVal base; - LakeList *params; - LakeSym *varargs; - LakeList *body; - Env *closure; +struct lake_fn +{ + LakeVal base; + LakeList *params; + LakeSym *varargs; + LakeList *body; + Env *closure; }; typedef struct lake_fn LakeFn; #define CALLABLE(x) (lake_is_type(TYPE_FN, x) || lake_is_type(TYPE_PRIM, x)) -struct lake_comment { - LakeVal base; - LakeStr *text; +struct lake_comment +{ + LakeVal base; + LakeStr *text; }; typedef struct lake_comment LakeComment; @@ -151,23 +161,30 @@ char *lake_repr(void *val); #include -#define ERR(...) do { \ - fprintf(stderr, "error: "); \ - fprintf(stderr, __VA_ARGS__); \ - fprintf(stderr, "\n"); \ +#define ERR(...) \ + do \ + { \ + fprintf(stderr, "error: "); \ + fprintf(stderr, __VA_ARGS__); \ + fprintf(stderr, "\n"); \ } while (0) -#define DIE(...) do { ERR(__VA_ARGS__); exit(1); } while(0) +#define DIE(...) \ + do \ + { \ + ERR(__VA_ARGS__); \ + exit(1); \ + } while (0) #define OOM() DIE("%s:%d out of memory", __FILE__, __LINE__) #include "bool.h" -#include "sym.h" -#include "int.h" -#include "str.h" -#include "list.h" +#include "comment.h" #include "dlist.h" #include "fn.h" -#include "comment.h" +#include "int.h" +#include "list.h" #include "primitive.h" +#include "str.h" +#include "sym.h" #endif \ No newline at end of file diff --git a/src/list.c b/src/list.c index 97fda54..eb3815d 100644 --- a/src/list.c +++ b/src/list.c @@ -1,20 +1,20 @@ -/** - * list.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * list.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include -#include +#include "list.h" #include "common.h" #include "int.h" #include "lake.h" -#include "list.h" #include "str.h" +#include +#include +#include /* TODO: use a linked list instead of this cheesy structure */ @@ -22,184 +22,198 @@ static LakeList *list_alloc(void) { - LakeList *list = malloc(sizeof(LakeList)); - VAL(list)->type = TYPE_LIST; - VAL(list)->size = sizeof(LakeList); - return list; + LakeList *list = malloc(sizeof(LakeList)); + VAL(list)->type = TYPE_LIST; + VAL(list)->size = sizeof(LakeList); + return list; } void list_free(LakeList *list) { - /* TODO: proper memory management ... refcounting? */ - if (list) { - free(list); - } + /* TODO: proper memory management ... refcounting? */ + if (list) + { + free(list); + } } LakeList *list_make(void) { - LakeList *list = list_make_with_capacity(LIST_INIT_CAP); - memset(list->vals, 0, list->cap); - return list; + LakeList *list = list_make_with_capacity(LIST_INIT_CAP); + memset(list->vals, 0, list->cap); + return list; } LakeList *list_cons(LakeVal *car, LakeVal *cdr) { - LakeList *list; - if (lake_is_type(TYPE_LIST, cdr)) { - list = LIST(cdr); - list_unshift(list, car); - } - else { - list = list_make_with_capacity(2); - list_append(list, car); - list_append(list, cdr); - } - return list; + LakeList *list; + if (lake_is_type(TYPE_LIST, cdr)) + { + list = LIST(cdr); + list_unshift(list, car); + } + else + { + list = list_make_with_capacity(2); + list_append(list, car); + list_append(list, cdr); + } + return list; } LakeList *list_make_with_capacity(size_t cap) { - LakeList *list = list_alloc(); - list->cap = cap; - list->n = 0; - list->vals = malloc(cap * sizeof(LakeVal *)); - return list; + LakeList *list = list_alloc(); + list->cap = cap; + list->n = 0; + list->vals = malloc(cap * sizeof(LakeVal *)); + return list; } LakeList *list_from_array(size_t n, LakeVal *vals[]) { - LakeList *list = list_make_with_capacity(n); - memcpy(list->vals, vals, n * sizeof(LakeVal *)); - list->n = n; - return list; + LakeList *list = list_make_with_capacity(n); + memcpy(list->vals, vals, n * sizeof(LakeVal *)); + list->n = n; + return list; } -LakeInt *list_len(LakeList *list) -{ - return int_from_c(list->n); -} +LakeInt *list_len(LakeList *list) { return int_from_c(list->n); } LakeList *list_copy(LakeList *list) { - return list_from_array(list->n, list->vals); + return list_from_array(list->n, list->vals); } static void list_grow(LakeList *list) { - list->cap *= 2; - list->vals = realloc(list->vals, list->cap * sizeof(LakeVal *)); - if (!list->vals) OOM(); + list->cap *= 2; + list->vals = realloc(list->vals, list->cap * sizeof(LakeVal *)); + if (!list->vals) OOM(); } LakeVal *list_set(LakeList *list, size_t i, LakeVal *val) { - if (i < list->n) { - list->vals[i] = val; - } - return NULL; + if (i < list->n) + { + list->vals[i] = val; + } + return NULL; } LakeVal *list_get(LakeList *list, LakeInt *li) { - int i = INT_VAL(li); - if (i >= 0 && i < list->n) { - return list->vals[i]; - } - return NULL; + int i = INT_VAL(li); + if (i >= 0 && i < list->n) + { + return list->vals[i]; + } + return NULL; } LakeVal *list_append(LakeList *list, LakeVal *val) { - if (list->n >= list->cap) { - list_grow(list); - } - list->vals[list->n++] = val; - return NULL; + if (list->n >= list->cap) + { + list_grow(list); + } + list->vals[list->n++] = val; + return NULL; } LakeVal *list_shift(LakeList *list) { - LakeVal *head = NULL; - if (list->n > 0) { - head = list->vals[0]; - size_t i; - size_t n = list->n; - for (i = 1; i < n; ++i) { - list->vals[i - 1] = list->vals[i]; + LakeVal *head = NULL; + if (list->n > 0) + { + head = list->vals[0]; + size_t i; + size_t n = list->n; + for (i = 1; i < n; ++i) + { + list->vals[i - 1] = list->vals[i]; + } + list->n--; } - list->n--; - } - return head; + return head; } LakeVal *list_unshift(LakeList *list, LakeVal *val) { - if (list->n == 0) { - list_append(list, val); - } - else { - if (list->n >= list->cap) { - list_grow(list); + if (list->n == 0) + { + list_append(list, val); } - size_t i = list->n++; - do { - list->vals[i] = list->vals[i - 1]; - } while (i--); - list->vals[0] = val; - } - return NULL; + else + { + if (list->n >= list->cap) + { + list_grow(list); + } + size_t i = list->n++; + do + { + list->vals[i] = list->vals[i - 1]; + } while (i--); + list->vals[0] = val; + } + return NULL; } LakeVal *list_pop(LakeList *list) { - LakeVal *tail = NULL; - if (list->n > 0) { - tail = list->vals[list->n - 1]; - list->n--; - } - return tail; + LakeVal *tail = NULL; + if (list->n > 0) + { + tail = list->vals[list->n - 1]; + list->n--; + } + return tail; } bool list_equal(LakeList *a, LakeList *b) { - if (a == b) return TRUE; - size_t n = LIST_N(a); - if (n != LIST_N(b)) return FALSE; - size_t i; - for (i = 0; i < n; ++i) { - if (!lake_equal(LIST_VAL(a, i), LIST_VAL(b, i))) return FALSE; - } - return TRUE; + if (a == b) return TRUE; + size_t n = LIST_N(a); + if (n != LIST_N(b)) return FALSE; + size_t i; + for (i = 0; i < n; ++i) + { + if (!lake_equal(LIST_VAL(a, i), LIST_VAL(b, i))) return FALSE; + } + return TRUE; } LakeStr *list_to_str(LakeList *list) { - char *s = list_repr(list); - LakeStr *str = lake_str_from_c(s); - free(s); - return str; + char *s = list_repr(list); + LakeStr *str = lake_str_from_c(s); + free(s); + return str; } char *list_repr(LakeList *list) { - char *s = malloc(2); - s[0] = '('; - s[1] = '\0'; - int i; - char *s2; - LakeVal *val; - for (i = 0; i < LIST_N(list); ++i) { - val = LIST_VAL(list, i); - if (val == VAL(list)) { - s2 = strdup("[Circular]"); + char *s = malloc(2); + s[0] = '('; + s[1] = '\0'; + int i; + char *s2; + LakeVal *val; + for (i = 0; i < LIST_N(list); ++i) + { + val = LIST_VAL(list, i); + if (val == VAL(list)) + { + s2 = strdup("[Circular]"); + } + else + { + s2 = lake_repr(val); + } + s = lake_str_append(s, s2); + free(s2); + if (i != LIST_N(list) - 1) s = lake_str_append(s, " "); } - else { - s2 = lake_repr(val); - } - s = lake_str_append(s, s2); - free(s2); - if (i != LIST_N(list) - 1) s = lake_str_append(s, " "); - } - return lake_str_append(s, ")"); + return lake_str_append(s, ")"); } diff --git a/src/list.h b/src/list.h index 57a6e58..855f79f 100644 --- a/src/list.h +++ b/src/list.h @@ -1,19 +1,19 @@ -/** - * list.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * list.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_LIST_H #define _LAKE_LIST_H -#include #include "common.h" #include "lake.h" #include "str.h" +#include LakeList *list_make(void); LakeList *list_cons(LakeVal *car, LakeVal *cdr); diff --git a/src/parse.c b/src/parse.c index 7fc07d9..33bcba1 100644 --- a/src/parse.c +++ b/src/parse.c @@ -1,30 +1,31 @@ -/** - * parse.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * parse.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include -#include +#include "parse.h" #include "common.h" #include "dlist.h" #include "int.h" #include "lake.h" #include "list.h" -#include "parse.h" #include "str.h" #include "sym.h" +#include +#include +#include -struct context { - char *s; - size_t n; - size_t i; - size_t mark; - LakeCtx *lake_ctx; +struct context +{ + char *s; + size_t n; + size_t i; + size_t mark; + LakeCtx *lake_ctx; }; typedef struct context Ctx; @@ -33,361 +34,380 @@ static int maybe_spaces(Ctx *ctx); static char peek(Ctx *ctx) { - if (ctx->i < ctx->n) return ctx->s[ctx->i]; - return PARSE_EOF; + if (ctx->i < ctx->n) return ctx->s[ctx->i]; + return PARSE_EOF; } static void warn_trailing(Ctx *ctx) { - maybe_spaces(ctx); - /* don't warn about trailing comments */ - if (ctx->i < ctx->n && peek(ctx) != ';') { - char *trailing = ctx->s + ctx->i; - fprintf(stderr, "warning: ignoring %d trailing chars: %s\n", (int)(ctx->n - ctx->i), trailing); - } + maybe_spaces(ctx); + /* don't warn about trailing comments */ + if (ctx->i < ctx->n && peek(ctx) != ';') + { + char *trailing = ctx->s + ctx->i; + fprintf(stderr, "warning: ignoring %d trailing chars: %s\n", + (int)(ctx->n - ctx->i), trailing); + } } LakeVal *parse_expr(LakeCtx *lake_ctx, char *s, size_t n) { - Ctx ctx = { s, n, 0, 0, lake_ctx }; - LakeVal *result = _parse_expr(&ctx); - warn_trailing(&ctx); - return result; + Ctx ctx = {s, n, 0, 0, lake_ctx}; + LakeVal *result = _parse_expr(&ctx); + warn_trailing(&ctx); + return result; } LakeList *parse_exprs(LakeCtx *lake_ctx, char *s, size_t n) { - Ctx ctx = { s, n, 0, 0, lake_ctx }; - LakeList *results = list_make(); - LakeVal *result; - while (ctx.i < ctx.n) { - result = _parse_expr(&ctx); - if (result && result != VAL(PARSE_ERR)) { - list_append(results, result); + Ctx ctx = {s, n, 0, 0, lake_ctx}; + LakeList *results = list_make(); + LakeVal *result; + while (ctx.i < ctx.n) + { + result = _parse_expr(&ctx); + if (result && result != VAL(PARSE_ERR)) + { + list_append(results, result); + } + else + { + list_free(results); + return NULL; + } } - else { - list_free(results); - return NULL; - } - } - warn_trailing(&ctx); - return results; + warn_trailing(&ctx); + return results; } LakeList *parse_naked_list(LakeCtx *lake_ctx, char *s, size_t n) { - Ctx ctx = { s, n, 0, 0, lake_ctx }; - LakeList *list = list_make(); - char c; - maybe_spaces(&ctx); - while ((c = peek(&ctx)) != PARSE_EOF) { - LakeVal *val = _parse_expr(&ctx); - if (val == VAL(PARSE_ERR)) { - list_free(list); - ctx.i = ctx.n; - return NULL; + Ctx ctx = {s, n, 0, 0, lake_ctx}; + LakeList *list = list_make(); + char c; + maybe_spaces(&ctx); + while ((c = peek(&ctx)) != PARSE_EOF) + { + LakeVal *val = _parse_expr(&ctx); + if (val == VAL(PARSE_ERR)) + { + list_free(list); + ctx.i = ctx.n; + return NULL; + } + list_append(list, val); } - list_append(list, val); - } - warn_trailing(&ctx); - return list; + warn_trailing(&ctx); + return list; } static void consume(Ctx *ctx, size_t n) { - if (ctx->i + n > ctx->n) { - DIE("cannot consume, no more input"); - } - ctx->i += n; + if (ctx->i + n > ctx->n) + { + DIE("cannot consume, no more input"); + } + ctx->i += n; } static char consume1(Ctx *ctx) { - char c = peek(ctx); - consume(ctx, 1); - return c; + char c = peek(ctx); + consume(ctx, 1); + return c; } static char ch(Ctx *ctx, char expected) { - char c = peek(ctx); - if (c == expected) { - consume1(ctx); - return c; - } - DIE("parse error, expected '%c' got '%c'", expected, c); + char c = peek(ctx); + if (c == expected) + { + consume1(ctx); + return c; + } + DIE("parse error, expected '%c' got '%c'", expected, c); } -static void mark(Ctx *ctx) -{ - ctx->mark = ctx->i; -} +static void mark(Ctx *ctx) { ctx->mark = ctx->i; } -static void backtrack(Ctx *ctx) -{ - ctx->i = ctx->mark; -} +static void backtrack(Ctx *ctx) { ctx->i = ctx->mark; } -static bool is_space(char c) -{ - return strchr(" \r\n\t", c) != NULL; -} +static bool is_space(char c) { return strchr(" \r\n\t", c) != NULL; } static bool is_letter(char c) { - return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'); + return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'); } static bool is_symbol(char c) { - return strchr("!$%&|*+-/:<=>?@^_~#", c) != NULL; + return strchr("!$%&|*+-/:<=>?@^_~#", c) != NULL; } -static bool is_digit(char c) -{ - return c >= '0' && c <= '9'; -} +static bool is_digit(char c) { return c >= '0' && c <= '9'; } static bool is_sym_char(char c) { - return is_letter(c) || is_symbol(c) || is_digit(c); + return is_letter(c) || is_symbol(c) || is_digit(c); } -static bool is_newline(char c) -{ - return c == '\n' || c == '\r'; -} +static bool is_newline(char c) { return c == '\n' || c == '\r'; } static char *parse_while(Ctx *ctx, bool (*is_valid)(char)) { - size_t n = 8; - size_t i = 0; - char *s = malloc(n); - char c; - while ((c = peek(ctx)) != PARSE_EOF && is_valid(c)) { - s[i++] = c; - consume1(ctx); - /* grow if necessary */ - if (i >= n) { - n *= 2; - if (!(s = realloc(s, n))) OOM(); + size_t n = 8; + size_t i = 0; + char *s = malloc(n); + char c; + while ((c = peek(ctx)) != PARSE_EOF && is_valid(c)) + { + s[i++] = c; + consume1(ctx); + /* grow if necessary */ + if (i >= n) + { + n *= 2; + if (!(s = realloc(s, n))) OOM(); + } } - } - s[i] = '\0'; - return s; + s[i] = '\0'; + return s; } static int maybe_spaces(Ctx *ctx) { - while (is_space(peek(ctx))) { - consume1(ctx); - } - return 1; + while (is_space(peek(ctx))) + { + consume1(ctx); + } + return 1; } static LakeVal *parse_int(Ctx *ctx) { - mark(ctx); - int n = 0; - char c = peek(ctx); - char sign = c == '-' ? -1 : 1; - if (c == '-' || c == '+') { - consume1(ctx); - /* if not followed by a digit it's a symbol */ - if (!is_digit(peek(ctx))) { - backtrack(ctx); - return NULL; + mark(ctx); + int n = 0; + char c = peek(ctx); + char sign = c == '-' ? -1 : 1; + if (c == '-' || c == '+') + { + consume1(ctx); + /* if not followed by a digit it's a symbol */ + if (!is_digit(peek(ctx))) + { + backtrack(ctx); + return NULL; + } } - } - while (is_digit(c = peek(ctx))) { - n *= 10; - n += c - '0'; - consume1(ctx); - } - /* if we're looking at a symbol character bail, it's not a number */ - if (is_sym_char(peek(ctx))) { - backtrack(ctx); - return NULL; - } - return VAL(int_from_c(sign * n)); + while (is_digit(c = peek(ctx))) + { + n *= 10; + n += c - '0'; + consume1(ctx); + } + /* if we're looking at a symbol character bail, it's not a number */ + if (is_sym_char(peek(ctx))) + { + backtrack(ctx); + return NULL; + } + return VAL(int_from_c(sign * n)); } static LakeVal *parse_sym(Ctx *ctx) { - LakeVal *val; - static int size = 1024; - char s[size]; - char c; - int i = 0; - while (is_sym_char(c = peek(ctx)) && i < size - 1) { - s[i++] = c; - consume1(ctx); - } - s[i] = '\0'; - if (strcmp(s, "#t") == 0) { - val = VAL(ctx->lake_ctx->T); - } - else if (strcmp(s, "#f") == 0) { - val = VAL(ctx->lake_ctx->F); - } - else { - val = VAL(sym_intern(ctx->lake_ctx, s)); - } - return val; + LakeVal *val; + static int size = 1024; + char s[size]; + char c; + int i = 0; + while (is_sym_char(c = peek(ctx)) && i < size - 1) + { + s[i++] = c; + consume1(ctx); + } + s[i] = '\0'; + if (strcmp(s, "#t") == 0) + { + val = VAL(ctx->lake_ctx->T); + } + else if (strcmp(s, "#f") == 0) + { + val = VAL(ctx->lake_ctx->F); + } + else + { + val = VAL(sym_intern(ctx->lake_ctx, s)); + } + return val; } static char escape_char(char c) { - switch (c) { + switch (c) + { case 'n': - c = '\n'; - break; + c = '\n'; + break; case 'r': - c = '\r'; - break; + c = '\r'; + break; case 't': - c = '\t'; - break; + c = '\t'; + break; default: - /* noop */ - break; - - } - return c; + /* noop */ + break; + } + return c; } static LakeVal *parse_str(Ctx *ctx) { - size_t n = 8; - size_t i = 0; - char *s = malloc(n); - char c; - ch(ctx, '"'); - while ((c = peek(ctx)) != PARSE_EOF && c != '"') { - /* handle backslash escapes */ - if (c == '\\') { - consume1(ctx); - c = escape_char(peek(ctx)); - if (c == PARSE_EOF) break; - } - s[i++] = c; - consume1(ctx); + size_t n = 8; + size_t i = 0; + char *s = malloc(n); + char c; + ch(ctx, '"'); + while ((c = peek(ctx)) != PARSE_EOF && c != '"') + { + /* handle backslash escapes */ + if (c == '\\') + { + consume1(ctx); + c = escape_char(peek(ctx)); + if (c == PARSE_EOF) break; + } + s[i++] = c; + consume1(ctx); /* grow if necessary */ - if (i >= n) { - n *= 2; - if (!(s = realloc(s, n))) OOM(); + if (i >= n) + { + n *= 2; + if (!(s = realloc(s, n))) OOM(); + } } - } - s[i] = '\0'; - ch(ctx, '"'); - LakeStr *str = lake_str_from_c(s); - free(s); - return VAL(str); + s[i] = '\0'; + ch(ctx, '"'); + LakeStr *str = lake_str_from_c(s); + free(s); + return VAL(str); } -static LakeVal* parse_list(Ctx *ctx) +static LakeVal *parse_list(Ctx *ctx) { - LakeList *list = list_make(); - ch(ctx, '('); - char c; - while ((c = peek(ctx)) != ')') { - if (c == PARSE_EOF) { - ERR("end of input while parsing list"); - list_free(list); - ctx-> i = ctx->n; - return NULL; - } + LakeList *list = list_make(); + ch(ctx, '('); + char c; + while ((c = peek(ctx)) != ')') + { + if (c == PARSE_EOF) + { + ERR("end of input while parsing list"); + list_free(list); + ctx->i = ctx->n; + return NULL; + } - /* check for dotted lists */ - if (c == '.') { - ch(ctx, '.'); - maybe_spaces(ctx); - LakeVal *tail = _parse_expr(ctx); - if (tail == VAL(PARSE_ERR)) { - list_free(list); - ctx->i = ctx->n; - return NULL; - } - ch(ctx, ')'); - return VAL(dlist_make(list, tail)); - } + /* check for dotted lists */ + if (c == '.') + { + ch(ctx, '.'); + maybe_spaces(ctx); + LakeVal *tail = _parse_expr(ctx); + if (tail == VAL(PARSE_ERR)) + { + list_free(list); + ctx->i = ctx->n; + return NULL; + } + ch(ctx, ')'); + return VAL(dlist_make(list, tail)); + } - LakeVal *val = _parse_expr(ctx); - if (val == VAL(PARSE_ERR)) { - list_free(list); - ctx->i = ctx->n; - return NULL; + LakeVal *val = _parse_expr(ctx); + if (val == VAL(PARSE_ERR)) + { + list_free(list); + ctx->i = ctx->n; + return NULL; + } + list_append(list, val); } - list_append(list, val); - } - ch(ctx, ')'); - return VAL(list); + ch(ctx, ')'); + return VAL(list); } static LakeVal *parse_quoted(Ctx *ctx) { - ch(ctx, '\''); - LakeList *list = list_make(); - list_append(list, VAL(sym_intern(ctx->lake_ctx, "quote"))); - list_append(list, _parse_expr(ctx)); - return VAL(list); + ch(ctx, '\''); + LakeList *list = list_make(); + list_append(list, VAL(sym_intern(ctx->lake_ctx, "quote"))); + list_append(list, _parse_expr(ctx)); + return VAL(list); } -static bool is_not_newline(char c) -{ - return !is_newline(c); -} +static bool is_not_newline(char c) { return !is_newline(c); } static LakeVal *parse_comment(Ctx *ctx) { - char *text = parse_while(ctx, is_not_newline); - LakeComment *comment = comment_from_c(text); - free(text); - return VAL(comment); + char *text = parse_while(ctx, is_not_newline); + LakeComment *comment = comment_from_c(text); + free(text); + return VAL(comment); } static LakeVal *_parse_expr(Ctx *ctx) { - maybe_spaces(ctx); + maybe_spaces(ctx); - LakeVal *result; - char c = peek(ctx); - /* try to parse a number, if that fails parse a symbol */ - if ((c >= '0' && c <= '9') || c == '-' || c == '+') { - result = VAL(parse_int(ctx)); - if (result == NULL) { - result = parse_sym(ctx); + LakeVal *result; + char c = peek(ctx); + /* try to parse a number, if that fails parse a symbol */ + if ((c >= '0' && c <= '9') || c == '-' || c == '+') + { + result = VAL(parse_int(ctx)); + if (result == NULL) + { + result = parse_sym(ctx); + } } - } - else if (is_letter(c) || is_symbol(c)) { - result = parse_sym(ctx); - } - else if (c == '"') { - result = parse_str(ctx); - } - else if (c == '\'') { - result = parse_quoted(ctx); - } - else if (c == '(') { - result = parse_list(ctx); - } - else if (c == ';') { - result = parse_comment(ctx); - } - else if (c == PARSE_EOF) { - result = NULL; - } - else { - ERR("unexpected char '%c'", c); - result = VAL(PARSE_ERR); - ctx->i = ctx->n; /* consume the rest */ - result = NULL; - } - maybe_spaces(ctx); + else if (is_letter(c) || is_symbol(c)) + { + result = parse_sym(ctx); + } + else if (c == '"') + { + result = parse_str(ctx); + } + else if (c == '\'') + { + result = parse_quoted(ctx); + } + else if (c == '(') + { + result = parse_list(ctx); + } + else if (c == ';') + { + result = parse_comment(ctx); + } + else if (c == PARSE_EOF) + { + result = NULL; + } + else + { + ERR("unexpected char '%c'", c); + result = VAL(PARSE_ERR); + ctx->i = ctx->n; /* consume the rest */ + result = NULL; + } + maybe_spaces(ctx); - return result; + return result; } diff --git a/src/parse.h b/src/parse.h index 25d85c4..074a8f3 100644 --- a/src/parse.h +++ b/src/parse.h @@ -1,17 +1,17 @@ -/** - * parse.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * parse.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_PARSE_H #define _LAKE_PARSE_H -#include #include "lake.h" +#include #define PARSE_EOF -1 #define PARSE_ERR -2 diff --git a/src/primitive.c b/src/primitive.c index a661024..1b18902 100644 --- a/src/primitive.c +++ b/src/primitive.c @@ -1,307 +1,338 @@ -/** - * primitive.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * primitive.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include +#include "primitive.h" #include "bool.h" -#include "common.h" #include "comment.h" +#include "common.h" #include "dlist.h" #include "env.h" -#include "int.h" -#include "dlist.h" #include "fn.h" -#include "list.h" +#include "int.h" #include "lake.h" -#include "primitive.h" +#include "list.h" #include "str.h" +#include static LakePrimitive *prim_alloc(void) { - LakePrimitive *prim = malloc(sizeof(LakePrimitive)); - VAL(prim)->type = TYPE_PRIM; - VAL(prim)->size = sizeof(LakePrimitive); - return prim; + LakePrimitive *prim = malloc(sizeof(LakePrimitive)); + VAL(prim)->type = TYPE_PRIM; + VAL(prim)->size = sizeof(LakePrimitive); + return prim; } LakePrimitive *prim_make(char *name, int arity, lake_prim fn) { - LakePrimitive *prim = prim_alloc(); - prim->name = strdup(name); - prim->arity = arity; - prim->fn = fn; - return prim; + LakePrimitive *prim = prim_alloc(); + prim->name = strdup(name); + prim->arity = arity; + prim->fn = fn; + return prim; } char *prim_repr(LakePrimitive *prim) { - size_t n = 16 + strlen(prim->name) + MAX_INT_LENGTH; - char *s = malloc(n); - snprintf(s, n, "<#primitive:%s(%d)>", prim->name, prim->arity); - return s; + size_t n = 16 + strlen(prim->name) + MAX_INT_LENGTH; + char *s = malloc(n); + snprintf(s, n, "<#primitive:%s(%d)>", prim->name, prim->arity); + return s; } static LakeVal *_car(LakeCtx *ctx, LakeList *args) { - LakeList *list = LIST(LIST_VAL(args, 0)); - if (lake_is_type(TYPE_LIST, list) && LIST_N(list) > 0) { - return LIST_VAL(list, 0); - } - if (lake_is_type(TYPE_DLIST, list)) { - return VAL(dlist_head(DLIST(list))); - } - ERR("not a pair: %s", lake_repr(list)); - return NULL; + LakeList *list = LIST(LIST_VAL(args, 0)); + if (lake_is_type(TYPE_LIST, list) && LIST_N(list) > 0) + { + return LIST_VAL(list, 0); + } + if (lake_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 (lake_is_type(TYPE_LIST, list) && LIST_N(list) > 0) { - LakeList *cdr = list_copy(list); - list_shift(cdr); - return VAL(cdr); - } - if (lake_is_type(TYPE_DLIST, list)) { - return dlist_tail(DLIST(list)); - } - ERR("not a pair: %s", lake_repr(list)); - return NULL; + LakeList *list = LIST(LIST_VAL(args, 0)); + if (lake_is_type(TYPE_LIST, list) && LIST_N(list) > 0) + { + LakeList *cdr = list_copy(list); + list_shift(cdr); + return VAL(cdr); + } + if (lake_is_type(TYPE_DLIST, list)) + { + return dlist_tail(DLIST(list)); + } + ERR("not a pair: %s", lake_repr(list)); + return NULL; } static LakeVal *_cons(LakeCtx *ctx, LakeList *args) { - LakeVal *car = LIST_VAL(args, 0); - LakeVal *cdr = LIST_VAL(args, 1); - return VAL(list_cons(car, cdr)); + LakeVal *car = LIST_VAL(args, 0); + LakeVal *cdr = LIST_VAL(args, 1); + return VAL(list_cons(car, cdr)); } static LakeVal *_nullP(LakeCtx *ctx, LakeList *args) { - LakeVal *val = list_shift(args); - LakeBool *is_null = lake_bool_from_int(ctx, lake_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) == 0); - return VAL(is_null); + LakeVal *val = list_shift(args); + LakeBool *is_null = lake_bool_from_int(ctx, lake_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 = lake_bool_from_int(ctx, lake_is_type(TYPE_LIST, val) && LIST_N(LIST(val)) > 0); - return VAL(is_pair); + LakeVal *val = list_shift(args); + LakeBool *is_pair = lake_bool_from_int(ctx, lake_is_type(TYPE_LIST, val) && + LIST_N(LIST(val)) > 0); + return VAL(is_pair); } static LakeVal *_isP(LakeCtx *ctx, LakeList *args) { - LakeVal *a = LIST_VAL(args, 0); - LakeVal *b = LIST_VAL(args, 1); - return VAL(lake_bool_from_int(ctx, lake_is(a, b))); + LakeVal *a = LIST_VAL(args, 0); + LakeVal *b = LIST_VAL(args, 1); + return VAL(lake_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(lake_bool_from_int(ctx, lake_equal(a, b))); + LakeVal *a = LIST_VAL(args, 0); + LakeVal *b = LIST_VAL(args, 1); + return VAL(lake_bool_from_int(ctx, lake_equal(a, b))); } static LakeVal *_not(LakeCtx *ctx, LakeList *args) { - LakeVal *val = list_shift(args); - LakeBool *not = lake_bool_from_int(ctx, lake_is_false(ctx, val)); - return VAL(not); + LakeVal *val = list_shift(args); + LakeBool *not = lake_bool_from_int(ctx, lake_is_false(ctx, val)); + return VAL(not ); } -#define ENSURE_INT(x, i) do { \ -if (!lake_is_type(TYPE_INT, x)) { \ - ERR("argument %zu is not an integer: %s", i, lake_repr(x)); \ - return NULL; \ - } \ -} while (0) +#define ENSURE_INT(x, i) \ + do \ + { \ + if (!lake_is_type(TYPE_INT, x)) \ + { \ + ERR("argument %zu is not an integer: %s", i, lake_repr(x)); \ + return NULL; \ + } \ + } while (0) static LakeVal *_add(LakeCtx *ctx, LakeList *args) { - int result = 0; - size_t n = LIST_N(args); - size_t i; - for (i = 0; i < n; ++i) { - LakeVal *v = LIST_VAL(args, i); - ENSURE_INT(v, i); - result += INT_VAL(INT(v)); - } - return VAL(int_from_c(result)); + int result = 0; + size_t n = LIST_N(args); + size_t i; + for (i = 0; i < n; ++i) + { + LakeVal *v = LIST_VAL(args, i); + ENSURE_INT(v, i); + result += INT_VAL(INT(v)); + } + return VAL(int_from_c(result)); } static LakeVal *_sub(LakeCtx *ctx, LakeList *args) { - size_t n = LIST_N(args); + size_t n = LIST_N(args); - if (n < 1) { - ERR("- requires at least one argument"); - return NULL; - } + if (n < 1) + { + ERR("- requires at least one argument"); + return NULL; + } - int result = 0; - size_t i; - for (i = 0; i < n; ++i) { - LakeVal *v = LIST_VAL(args, i); - ENSURE_INT(v, i); - result -= INT_VAL(INT(v)); - } - return VAL(int_from_c(result)); + int result = 0; + size_t i; + for (i = 0; i < n; ++i) + { + LakeVal *v = LIST_VAL(args, i); + ENSURE_INT(v, i); + result -= INT_VAL(INT(v)); + } + return VAL(int_from_c(result)); } static LakeVal *_mul(LakeCtx *ctx, LakeList *args) { - int result = 1; - size_t n = LIST_N(args); - size_t i; - for (i = 0; i < n; ++i) { - LakeVal *v = LIST_VAL(args, i); - ENSURE_INT(v, i); - result *= INT_VAL(INT(v)); - } - return VAL(int_from_c(result)); + int result = 1; + size_t n = LIST_N(args); + size_t i; + for (i = 0; i < n; ++i) + { + LakeVal *v = LIST_VAL(args, i); + ENSURE_INT(v, i); + result *= INT_VAL(INT(v)); + } + return VAL(int_from_c(result)); } #define DIVIDE_BY_ZERO() ERR("divide by zero") static LakeVal *_div(LakeCtx *ctx, LakeList *args) { - size_t n = LIST_N(args); + size_t n = LIST_N(args); - if (n < 1) { - ERR("/ requires at least one argument"); - return NULL; - } - - LakeVal *v = LIST_VAL(args, 0); - ENSURE_INT(v, (size_t)0); - int result = INT_VAL(INT(v)); - - if (n == 1) { - if (result == 0) { - DIVIDE_BY_ZERO(); - return NULL; - } - result = 1 / result; - } - else { - size_t i; - for (i = 1; i < n; ++i) { - v = LIST_VAL(args, i); - ENSURE_INT(v, i); - int val = INT_VAL(INT(v)); - if (val == 0) { - DIVIDE_BY_ZERO(); + if (n < 1) + { + ERR("/ requires at least one argument"); return NULL; - } - result /= val; } - } - return VAL(int_from_c(result)); + + LakeVal *v = LIST_VAL(args, 0); + ENSURE_INT(v, (size_t)0); + int result = INT_VAL(INT(v)); + + if (n == 1) + { + if (result == 0) + { + DIVIDE_BY_ZERO(); + return NULL; + } + result = 1 / result; + } + else + { + size_t i; + for (i = 1; i < n; ++i) + { + v = LIST_VAL(args, i); + ENSURE_INT(v, i); + int val = INT_VAL(INT(v)); + if (val == 0) + { + DIVIDE_BY_ZERO(); + return NULL; + } + result /= val; + } + } + return VAL(int_from_c(result)); } static LakeVal *_int_eq(LakeCtx *ctx, LakeList *args) { - bool result = TRUE; - size_t n = LIST_N(args); - size_t i; - int curr, prev; - for (i = 0; i < n; ++i) { - LakeVal *v = LIST_VAL(args, i); - ENSURE_INT(v, i); - curr = INT_VAL(INT(v)); - if (i > 0) { - result = result && curr == prev; + bool result = TRUE; + size_t n = LIST_N(args); + size_t i; + int curr, prev; + for (i = 0; i < n; ++i) + { + LakeVal *v = LIST_VAL(args, i); + ENSURE_INT(v, i); + curr = INT_VAL(INT(v)); + if (i > 0) + { + result = result && curr == prev; + } + prev = INT_VAL(INT(v)); } - prev = INT_VAL(INT(v)); - } - return VAL(lake_bool_from_int(ctx, result)); + return VAL(lake_bool_from_int(ctx, result)); } static LakeVal *_int_lt(LakeCtx *ctx, LakeList *args) { - bool result = TRUE; - size_t n = LIST_N(args); - size_t i; - int curr, prev; + bool result = TRUE; + size_t n = LIST_N(args); + size_t i; + int curr, prev; - if (n > 1) { - for (i = 0; i < n; ++i) { - LakeVal *v = LIST_VAL(args, i); - ENSURE_INT(v, i); - curr = INT_VAL(INT(v)); - if (i > 0) { - result = result && prev < curr; - } - prev = INT_VAL(INT(v)); + if (n > 1) + { + for (i = 0; i < n; ++i) + { + LakeVal *v = LIST_VAL(args, i); + ENSURE_INT(v, i); + curr = INT_VAL(INT(v)); + if (i > 0) + { + result = result && prev < curr; + } + prev = INT_VAL(INT(v)); + } } - } - return VAL(lake_bool_from_int(ctx, result)); + return VAL(lake_bool_from_int(ctx, result)); } static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args) { - bool result = TRUE; - size_t n = LIST_N(args); - size_t i; - int curr, prev; + bool result = TRUE; + size_t n = LIST_N(args); + size_t i; + int curr, prev; - if (n > 1) { - for (i = 0; i < n; ++i) { - LakeVal *v = LIST_VAL(args, i); - ENSURE_INT(v, i); - curr = INT_VAL(INT(v)); - if (i > 0) { - result = result && prev > curr; - } - prev = INT_VAL(INT(v)); + if (n > 1) + { + for (i = 0; i < n; ++i) + { + LakeVal *v = LIST_VAL(args, i); + ENSURE_INT(v, i); + curr = INT_VAL(INT(v)); + if (i > 0) + { + result = result && prev > curr; + } + prev = INT_VAL(INT(v)); + } } - } - return VAL(lake_bool_from_int(ctx, result)); + return VAL(lake_bool_from_int(ctx, result)); } static LakeVal *_set_carB(LakeCtx *ctx, LakeList *args) { - LakeList *list = LIST(LIST_VAL(args, 0)); - if (lake_is_type(TYPE_LIST, list)) { - LakeVal *new_car = LIST_VAL(args, 1); - if (LIST_N(list) == 0) { - list_append(list, new_car); + LakeList *list = LIST(LIST_VAL(args, 0)); + if (lake_is_type(TYPE_LIST, list)) + { + LakeVal *new_car = LIST_VAL(args, 1); + if (LIST_N(list) == 0) + { + list_append(list, new_car); + } + else + { + list_set(list, 0, new_car); + } + return VAL(list); } - else { - list_set(list, 0, new_car); - } - return VAL(list); - } - ERR("not a pair: %s", lake_repr(list)); - return NULL; + ERR("not a pair: %s", lake_repr(list)); + return NULL; } static LakeVal *_display(LakeCtx *ctx, LakeList *args) { - size_t n = LIST_N(args); - size_t i; - int space = 0; - for (i = 0; i < n; ++i) { - if (space) putchar(' '); - printf("%s", lake_repr(LIST_VAL(args, i))); - space = 1; - } - putchar('\n'); - return NULL; + size_t n = LIST_N(args); + size_t i; + int space = 0; + for (i = 0; i < n; ++i) + { + if (space) putchar(' '); + printf("%s", lake_repr(LIST_VAL(args, i))); + space = 1; + } + putchar('\n'); + return NULL; } -#define DEFINE_PREDICATE(name, type) \ -static LakeVal *_## name ##P(LakeCtx *ctx, LakeList *args) \ -{ \ - return VAL(lake_bool_from_int(ctx, lake_is_type(type, LIST_VAL(args, 0)))); \ -} +#define DEFINE_PREDICATE(name, type) \ + static LakeVal *_##name##P(LakeCtx *ctx, LakeList *args) \ + { \ + return VAL( \ + lake_bool_from_int(ctx, lake_is_type(type, LIST_VAL(args, 0)))); \ + } DEFINE_PREDICATE(symbol, TYPE_SYM) DEFINE_PREDICATE(list, TYPE_LIST) @@ -317,44 +348,44 @@ DEFINE_PREDICATE(primitive, TYPE_PRIM) void bind_primitives(LakeCtx *ctx) { -#define DEFINE(name, fn, arity) env_define(ctx->toplevel, \ - sym_intern(ctx, name), \ - VAL(prim_make(name, arity, fn))) +#define DEFINE(name, fn, arity) \ + env_define(ctx->toplevel, sym_intern(ctx, name), \ + VAL(prim_make(name, arity, fn))) - DEFINE("car", _car, 1); - DEFINE("cdr", _cdr, 1); - DEFINE("cons", _cons, 2); - DEFINE("null?", _nullP, 1); - DEFINE("pair?", _pairP, 1); - DEFINE("is?", _isP, 2); - DEFINE("equal?", _equalP, 2); - DEFINE("not", _not, 1); - DEFINE("+", _add, ARITY_VARARGS); - DEFINE("-", _sub, ARITY_VARARGS); - DEFINE("*", _mul, ARITY_VARARGS); - DEFINE("/", _div, ARITY_VARARGS); - DEFINE("=", _int_eq, ARITY_VARARGS); - DEFINE("<", _int_lt, ARITY_VARARGS); - DEFINE(">", _int_gt, ARITY_VARARGS); - DEFINE("set-car!", _set_carB, 2); + DEFINE("car", _car, 1); + DEFINE("cdr", _cdr, 1); + DEFINE("cons", _cons, 2); + DEFINE("null?", _nullP, 1); + DEFINE("pair?", _pairP, 1); + DEFINE("is?", _isP, 2); + DEFINE("equal?", _equalP, 2); + DEFINE("not", _not, 1); + DEFINE("+", _add, ARITY_VARARGS); + DEFINE("-", _sub, ARITY_VARARGS); + DEFINE("*", _mul, ARITY_VARARGS); + DEFINE("/", _div, ARITY_VARARGS); + DEFINE("=", _int_eq, ARITY_VARARGS); + DEFINE("<", _int_lt, ARITY_VARARGS); + DEFINE(">", _int_gt, ARITY_VARARGS); + DEFINE("set-car!", _set_carB, 2); - DEFINE("display", _display, ARITY_VARARGS); + DEFINE("display", _display, ARITY_VARARGS); - DEFINE("symbol?", _symbolP, 1); - DEFINE("list?", _listP, 1); - DEFINE("dotted-list?", _dotted_listP, 1); - DEFINE("number?", _numberP, 1); - DEFINE("integer?", _integerP, 1); - DEFINE("string?", _stringP, 1); - DEFINE("bool?", _boolP, 1); - DEFINE("function?", _functionP, 1); - DEFINE("primitive?", _primitiveP, 1); + DEFINE("symbol?", _symbolP, 1); + DEFINE("list?", _listP, 1); + DEFINE("dotted-list?", _dotted_listP, 1); + DEFINE("number?", _numberP, 1); + DEFINE("integer?", _integerP, 1); + DEFINE("string?", _stringP, 1); + DEFINE("bool?", _boolP, 1); + DEFINE("function?", _functionP, 1); + DEFINE("primitive?", _primitiveP, 1); - /* string=? */ - /* string< */ - /* string> */ - /* string-concatenate */ - /* string-slice */ + /* string=? */ + /* string< */ + /* string> */ + /* string-concatenate */ + /* string-slice */ - #undef DEFINE +#undef DEFINE } diff --git a/src/primitive.h b/src/primitive.h index 40e9467..a113cb2 100644 --- a/src/primitive.h +++ b/src/primitive.h @@ -1,11 +1,11 @@ -/** - * primitive.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * primitive.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_PRIMITIVE_H #define _LAKE_PRIMITIVE_H diff --git a/src/repl.c b/src/repl.c index 9d7af1a..96943f2 100644 --- a/src/repl.c +++ b/src/repl.c @@ -1,19 +1,15 @@ -/** - * repl.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - * A quick and dirty scheme written in C, for fun and to use while - * reading The Little Schemer. - * - */ +/** + * repl.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + * A quick and dirty scheme written in C, for fun and to use while + * reading The Little Schemer. + * + */ -#include -#include -#include -#include #include "common.h" #include "env.h" #include "eval.h" @@ -21,146 +17,167 @@ #include "list.h" #include "parse.h" #include "str.h" +#include +#include +#include +#include -void print(LakeVal *expr) -{ - printf("%s\n", lake_repr(expr)); -} +void print(LakeVal *expr) { printf("%s\n", lake_repr(expr)); } static char first_char(char *s) { - char c; - while ((c = *s++) && (c == ' ' || c == '\n' || c == '\t')); - return c; + char c; + while ((c = *s++) && (c == ' ' || c == '\n' || c == '\t')) + ; + return c; } static LakeVal *prompt_read(LakeCtx *ctx, Env *env, char *prompt) { - static int n = 1024; - printf("%s", prompt); - char buf[n]; - if (!fgets(buf, n, stdin)) { - if (ferror(stdin)) { - fprintf(stderr, "error: cannot read from stdin"); + static int n = 1024; + printf("%s", prompt); + char buf[n]; + if (!fgets(buf, n, stdin)) + { + if (ferror(stdin)) + { + fprintf(stderr, "error: cannot read from stdin"); + } + if (feof(stdin)) + { + return VAL(EOF); + } + return NULL; } - if (feof(stdin)) { - return VAL(EOF); + /* trim the newline if any */ + buf[strcspn(buf, "\n")] = '\0'; + + /* parse list expressions */ + if (first_char(buf) == '(') + { + return parse_expr(ctx, buf, strlen(buf)); } - return NULL; - } - /* trim the newline if any */ - buf[strcspn(buf, "\n")] = '\0'; - /* parse list expressions */ - if (first_char(buf) == '(') { - return parse_expr(ctx, buf, strlen(buf)); - } - - /* try to parse a naked call without parens - (makes the repl more palatable) */ + /* try to parse a naked call without parens + (makes the repl more palatable) */ LakeList *list = parse_naked_list(ctx, buf, strlen(buf)); - if (!list || LIST_N(list) == 0) return NULL; + if (!list || LIST_N(list) == 0) return NULL; - LakeVal *result; + LakeVal *result; - /* naked call */ - LakeVal *head; - if (is_special_form(ctx, list) || - (LIST_N(list) > 1 && (head = eval(ctx, env, LIST_VAL(list, 0))) && CALLABLE(head))) { - result = VAL(list); - } + /* naked call */ + LakeVal *head; + if (is_special_form(ctx, list) || + (LIST_N(list) > 1 && (head = eval(ctx, env, LIST_VAL(list, 0))) && + CALLABLE(head))) + { + result = VAL(list); + } - /* probably not function calls, just give the first expr - (maybe do an implicit progn thing here) */ - else { - result = LIST_VAL(list, 0); - } + /* probably not function calls, just give the first expr + (maybe do an implicit progn thing here) */ + else + { + result = LIST_VAL(list, 0); + } - return result; + return result; } static void run_repl(LakeCtx *ctx, Env *env) { - puts("Lake Scheme v" LAKE_VERSION); - LakeVal *expr; - LakeVal *result; - for (;;) { - expr = prompt_read(ctx, env, "> "); - if (expr == VAL(EOF)) break; - if (expr == VAL(PARSE_ERR)) { - ERR("parse error"); - continue; + puts("Lake Scheme v" LAKE_VERSION); + LakeVal *expr; + LakeVal *result; + for (;;) + { + expr = prompt_read(ctx, env, "> "); + if (expr == VAL(EOF)) break; + if (expr == VAL(PARSE_ERR)) + { + ERR("parse error"); + continue; + } + if (expr) + { + result = eval(ctx, env, expr); + if (result) print(result); + } } - if (expr) { - result = eval(ctx, env, expr); - if (result) print(result); - } - } } static char *read_file(char const *filename) { - FILE *fp = fopen(filename, "r"); - if (fp) { - size_t size = 4096; - char buf[size]; - size_t n = size; - size_t i = 0; - size_t read; - char *s = malloc(n); + FILE *fp = fopen(filename, "r"); + if (fp) + { + size_t size = 4096; + char buf[size]; + size_t n = size; + size_t i = 0; + size_t read; + char *s = malloc(n); - while (!feof(fp) && !ferror(fp)) { - read = fread(buf, 1, size, fp); - if (i + read > n) { - n += size; - if (!(s = realloc(s, n))) OOM(); - } - memcpy(s + i, buf, read); - i += read; - } - s[i] = '\0'; - if (ferror(fp)) { - ERR("failed to read file %s: %s", filename, strerror(errno)); - return NULL; - } - fclose(fp); + while (!feof(fp) && !ferror(fp)) + { + read = fread(buf, 1, size, fp); + if (i + read > n) + { + n += size; + if (!(s = realloc(s, n))) OOM(); + } + memcpy(s + i, buf, read); + i += read; + } + s[i] = '\0'; + if (ferror(fp)) + { + ERR("failed to read file %s: %s", filename, strerror(errno)); + return NULL; + } + fclose(fp); - return s; - } - else { - ERR("cannot open file %s: %s", filename, strerror(errno)); - return NULL; - } + return s; + } + else + { + ERR("cannot open file %s: %s", filename, strerror(errno)); + return NULL; + } } -int main (int argc, char const *argv[]) +int main(int argc, char const *argv[]) { - /* create an execution context */ - LakeCtx *ctx = lake_init(); + /* create an execution context */ + LakeCtx *ctx = lake_init(); - /* create and bind args */ - LakeVal **argVals = malloc(argc * sizeof(LakeVal *)); - int i; - for (i = 0; i < argc; ++i) { - argVals[i] = VAL(lake_str_from_c((char *)argv[i])); - } - LakeList *args = list_from_array(argc, argVals); - free(argVals); - env_define(ctx->toplevel, sym_intern(ctx, "args"), VAL(args)); - - /* if a filename is given load the file */ - if (argc > 1) { - char *text = read_file(argv[1]); - if (text) { - LakeList *exprs = parse_exprs(ctx, text, strlen(text)); - if (exprs) { - eval_exprs(ctx, ctx->toplevel, exprs); - } + /* create and bind args */ + LakeVal **argVals = malloc(argc * sizeof(LakeVal *)); + int i; + for (i = 0; i < argc; ++i) + { + argVals[i] = VAL(lake_str_from_c((char *)argv[i])); } - } + LakeList *args = list_from_array(argc, argVals); + free(argVals); + env_define(ctx->toplevel, sym_intern(ctx, "args"), VAL(args)); - /* run the repl */ - run_repl(ctx, ctx->toplevel); + /* if a filename is given load the file */ + if (argc > 1) + { + char *text = read_file(argv[1]); + if (text) + { + LakeList *exprs = parse_exprs(ctx, text, strlen(text)); + if (exprs) + { + eval_exprs(ctx, ctx->toplevel, exprs); + } + } + } - return 0; + /* run the repl */ + run_repl(ctx, ctx->toplevel); + + return 0; } diff --git a/src/str.c b/src/str.c index b05606e..b7a7d35 100644 --- a/src/str.c +++ b/src/str.c @@ -1,77 +1,62 @@ -/** - * str.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * str.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include +#include "str.h" #include "common.h" #include "int.h" #include "lake.h" -#include "str.h" +#include +#include #define MIN(a, b) ((a) < (b) ? (a) : (b)) static LakeStr *lake_str_alloc(void) { - LakeStr *str = malloc(sizeof(LakeStr)); - VAL(str)->type = TYPE_STR; - VAL(str)->size = sizeof(LakeStr); - return str; + LakeStr *str = malloc(sizeof(LakeStr)); + VAL(str)->type = TYPE_STR; + VAL(str)->size = sizeof(LakeStr); + return str; } void lake_str_free(LakeStr *str) { - free(STR_S(str)); - free(str); + free(STR_S(str)); + free(str); } static LakeVal *lake_str_set(LakeStr *str, char *s) { - STR_N(str) = strlen(s); - STR_S(str) = strndup(s, STR_N(str)); - return NULL; + STR_N(str) = strlen(s); + STR_S(str) = strndup(s, STR_N(str)); + return NULL; } LakeStr *lake_str_from_c(char *s) { - LakeStr *str = lake_str_alloc(); - lake_str_set(str, s); - return str; + LakeStr *str = lake_str_alloc(); + lake_str_set(str, s); + return str; } -LakeStr *lake_str_make(void) -{ - return lake_str_from_c(""); -} +LakeStr *lake_str_make(void) { return lake_str_from_c(""); } -LakeInt *lake_str_len(LakeStr *str) -{ - return int_from_c(STR_N(str)); -} +LakeInt *lake_str_len(LakeStr *str) { return int_from_c(STR_N(str)); } -LakeStr *lake_str_copy(LakeStr *str) -{ - return lake_str_from_c(STR_S(str)); -} +LakeStr *lake_str_copy(LakeStr *str) { return lake_str_from_c(STR_S(str)); } -char *lake_str_val(LakeStr *str) -{ - return strndup(STR_S(str), STR_N(str)); -} +char *lake_str_val(LakeStr *str) { return strndup(STR_S(str), STR_N(str)); } bool lake_str_equal(LakeStr *a, LakeStr *b) { - if (STR_N(a) != STR_N(b)) return FALSE; - size_t n = MIN(STR_N(a), STR_N(b)); - return strncmp(STR_S(a), STR_S(b), n) == 0; + if (STR_N(a) != STR_N(b)) return FALSE; + size_t n = MIN(STR_N(a), STR_N(b)); + return strncmp(STR_S(a), STR_S(b), n) == 0; } -LakeStr *lake_str_to_str(LakeStr *str) -{ - return lake_str_copy(str); -} +LakeStr *lake_str_to_str(LakeStr *str) { return lake_str_copy(str); } diff --git a/src/str.h b/src/str.h index 1d7b570..4242444 100644 --- a/src/str.h +++ b/src/str.h @@ -1,11 +1,11 @@ -/** - * str.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * str.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_STRING_H #define _LAKE_STRING_H diff --git a/src/sym.c b/src/sym.c index e7ed7ee..f189bd7 100644 --- a/src/sym.c +++ b/src/sym.c @@ -1,73 +1,65 @@ -/** - * sym.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * sym.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include -#include -#include +#include "sym.h" #include "common.h" #include "env.h" #include "lake.h" #include "str.h" -#include "sym.h" +#include +#include +#include +#include /* djb's hash * http://www.cse.yorku.ca/~oz/hash.html */ static uint32_t str_hash(const char *s) { - char c; - uint32_t h = 5381; + char c; + uint32_t h = 5381; - while ((c = *s++)) - h = ((h << 5) + h) ^ c; + while ((c = *s++)) + h = ((h << 5) + h) ^ c; - return h; + return h; } static LakeSym *sym_alloc(void) { - LakeSym *sym = malloc(sizeof(LakeSym)); - VAL(sym)->type = TYPE_SYM; - VAL(sym)->size = sizeof(LakeSym); - return sym; + LakeSym *sym = malloc(sizeof(LakeSym)); + VAL(sym)->type = TYPE_SYM; + VAL(sym)->size = sizeof(LakeSym); + return sym; } LakeSym *sym_intern(LakeCtx *ctx, char *s) { - LakeSym *sym = lake_hash_get(ctx->symbols, s); - if (!sym) { - sym = sym_alloc(); - sym->n = strlen(s); - sym->s = strndup(s, sym->n); - sym->hash = str_hash(s); - lake_hash_put(ctx->symbols, sym->s, sym); - } - return sym; + LakeSym *sym = lake_hash_get(ctx->symbols, s); + if (!sym) + { + sym = sym_alloc(); + sym->n = strlen(s); + sym->s = strndup(s, sym->n); + sym->hash = str_hash(s); + lake_hash_put(ctx->symbols, sym->s, sym); + } + return sym; } -LakeStr *sym_to_str(LakeSym *sym) -{ - return lake_str_from_c(sym->s); -} +LakeStr *sym_to_str(LakeSym *sym) { return lake_str_from_c(sym->s); } LakeSym *sym_from_str(LakeCtx *ctx, LakeStr *str) { - return sym_intern(ctx, str->s); + return sym_intern(ctx, str->s); } -char *sym_repr(LakeSym *sym) -{ - return strndup(sym->s, sym->n); -} +char *sym_repr(LakeSym *sym) { return strndup(sym->s, sym->n); } -unsigned long sym_val(LakeSym *sym) -{ - return sym->hash; -} +unsigned long sym_val(LakeSym *sym) { return sym->hash; } diff --git a/src/sym.h b/src/sym.h index fcc7e69..be72bc8 100644 --- a/src/sym.h +++ b/src/sym.h @@ -1,11 +1,11 @@ -/** - * sym.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * sym.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_SYM_H #define _LAKE_SYM_H diff --git a/test/laketest.c b/test/laketest.c index 05e7d3d..6df1562 100644 --- a/test/laketest.c +++ b/test/laketest.c @@ -1,22 +1,22 @@ -/** - * laketest.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - * Based on MinUnit: http://www.jera.com/techinfo/jtns/jtn002.html - * - */ +/** + * laketest.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + * Based on MinUnit: http://www.jera.com/techinfo/jtns/jtn002.html + * + */ +#include "lake.h" +#include "eval.h" +#include "laketest.h" +#include "parse.h" #include #include #include #include -#include "eval.h" -#include "lake.h" -#include "laketest.h" -#include "parse.h" static int captured = 0; @@ -29,7 +29,7 @@ static void capture_output(void) close(2); int newfd = dup(fd); close(fd); - + fd = open("./tmp", O_WRONLY); close(1); newfd = dup(fd); @@ -40,7 +40,7 @@ void restore_output(void) { if (!captured) return; captured = 0; - + freopen("/dev/tty", "a", stdout); freopen("/dev/tty", "a", stderr); unlink("./tmp"); @@ -54,16 +54,19 @@ int lt_run_tests(char *title, test_fn *tests) test_fn test; printf("-- %s --\n", title); capture_output(); - while ((test = *(tests++))) { + while ((test = *(tests++))) + { if ((message = test())) break; n_tests++; } restore_output(); pass = message == 0; - if (pass) { + if (pass) + { fprintf(stderr, "PASS: %d test%s\n", n_tests, n_tests == 1 ? "" : "s"); } - else { + else + { fprintf(stderr, "FAIL: %s\n", message); } return pass; diff --git a/test/laketest.h b/test/laketest.h index 77cf5c4..74f1eaa 100644 --- a/test/laketest.h +++ b/test/laketest.h @@ -1,26 +1,29 @@ -/** - * laketest.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - * Based on MinUnit: http://www.jera.com/techinfo/jtns/jtn002.html - * - */ +/** + * laketest.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + * Based on MinUnit: http://www.jera.com/techinfo/jtns/jtn002.html + * + */ -#include #include "lake.h" +#include void restore_output(void); -#define lt_assert(message, test) do { \ - if (!(test)) { \ - restore_output(); \ - fprintf(stderr, "%s:%d assertion failed: " #test "\n", \ - __FILE__, __LINE__); \ - return message; \ - } \ +#define lt_assert(message, test) \ + do \ + { \ + if (!(test)) \ + { \ + restore_output(); \ + fprintf(stderr, "%s:%d assertion failed: " #test "\n", __FILE__, \ + __LINE__); \ + return message; \ + } \ } while (0) typedef char *(*test_fn)(void); diff --git a/test/test_comment.c b/test/test_comment.c index b15e6e6..3b61d1a 100644 --- a/test/test_comment.c +++ b/test/test_comment.c @@ -1,17 +1,17 @@ /** - * test_comment.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_comment.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include "laketest.h" #include "comment.h" #include "lake.h" +#include "laketest.h" #include "str.h" +#include #define TEXT "you are not expected to understand this" @@ -26,27 +26,22 @@ 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 - }); + 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); -} +void setup(void) { text = lake_str_from_c(TEXT); } /* LakeComment *comment_make(LakeStr *text) */ static char *test_comment_make(void) { LakeComment *comment = comment_make(text); lt_assert("type is not TYPE_COMM", lake_is_type(TYPE_COMM, comment)); - lt_assert("value size is incorrect", lake_val_size(comment) == sizeof(LakeComment)); - lt_assert("comment text is incorrect", lake_str_equal(text, COMM_TEXT(comment))); + lt_assert("value size is incorrect", + lake_val_size(comment) == sizeof(LakeComment)); + lt_assert("comment text is incorrect", + lake_str_equal(text, COMM_TEXT(comment))); return 0; } @@ -55,8 +50,10 @@ static char *test_comment_from_c(void) { LakeComment *comment = comment_from_c(TEXT); lt_assert("type is not TYPE_COMM", lake_is_type(TYPE_COMM, comment)); - lt_assert("value size is incorrect", lake_val_size(comment) == sizeof(LakeComment)); - lt_assert("comment text is incorrect", lake_str_equal(text, COMM_TEXT(comment))); + lt_assert("value size is incorrect", + lake_val_size(comment) == sizeof(LakeComment)); + lt_assert("comment text is incorrect", + lake_str_equal(text, COMM_TEXT(comment))); return 0; } @@ -64,7 +61,8 @@ static char *test_comment_from_c(void) static char *test_comment_repr(void) { LakeComment *comment = comment_make(text); - lt_assert("comment_repr is incorrect", strncmp(comment_repr(comment), TEXT, strlen(TEXT)) == 0); + lt_assert("comment_repr is incorrect", + strncmp(comment_repr(comment), TEXT, strlen(TEXT)) == 0); return 0; } @@ -73,7 +71,8 @@ static char *test_comment_equal(void) { LakeComment *a = comment_make(text); LakeComment *b = comment_from_c(TEXT); - LakeComment *c = comment_from_c("and now for something completely different"); + LakeComment *c = + comment_from_c("and now for something completely different"); lt_assert("comment a != a", comment_equal(a, a)); lt_assert("comment a != b", comment_equal(a, b)); lt_assert("comment a == c", !comment_equal(a, c)); diff --git a/test/test_dlist.c b/test/test_dlist.c index 411f5ad..1d4a26a 100644 --- a/test/test_dlist.c +++ b/test/test_dlist.c @@ -1,17 +1,17 @@ /** - * test_dlist.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_dlist.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include #include "common.h" -#include "laketest.h" #include "lake.h" +#include "laketest.h" #include "list.h" +#include void setup(void); static char *test_dlist_make(void); @@ -26,12 +26,9 @@ 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 - }); + return !lt_run_tests( + "Dotted Lists", + (test_fn[]){test_dlist_make, test_dlist_repr, test_dlist_equal, NULL}); } void setup(void) @@ -45,7 +42,8 @@ void setup(void) static char *test_dlist_make(void) { lt_assert("type is not TYPE_DLIST", lake_is_type(TYPE_DLIST, dlist)); - lt_assert("value size is incorrect", lake_val_size(dlist) == sizeof(LakeDottedList)); + lt_assert("value size is incorrect", + lake_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))); @@ -55,7 +53,8 @@ static char *test_dlist_make(void) /* char *dlist_repr(LakeDottedList *dlist) */ static char *test_dlist_repr(void) { - lt_assert("dlist_repr is incorrect", strncmp(dlist_repr(dlist), REPR, strlen(REPR)) == 0); + lt_assert("dlist_repr is incorrect", + strncmp(dlist_repr(dlist), REPR, strlen(REPR)) == 0); char *REPR2 = "(spam eggs bacon spam eggs . spam)"; LakeCtx *lake = lake_init(); diff --git a/test/test_env.c b/test/test_env.c index 06ef6dd..7d37822 100644 --- a/test/test_env.c +++ b/test/test_env.c @@ -1,16 +1,16 @@ /** - * test_env.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_env.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #include "common.h" -#include "laketest.h" #include "env.h" #include "lake.h" +#include "laketest.h" void setup(void); static char *test_env_make(void); @@ -31,14 +31,9 @@ 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 - }); + 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) @@ -59,7 +54,8 @@ static char *test_env_make(void) lt_assert("toplevel->bindings is NULL", toplevel->bindings != NULL); lt_assert("firstlevel is NULL", firstlevel != NULL); - lt_assert("firstlevel->parent is not toplevel", firstlevel->parent == toplevel); + lt_assert("firstlevel->parent is not toplevel", + firstlevel->parent == toplevel); return 0; } diff --git a/test/test_eval.c b/test/test_eval.c index 127c325..c098d64 100644 --- a/test/test_eval.c +++ b/test/test_eval.c @@ -1,16 +1,16 @@ /** - * test_eval.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_eval.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include "laketest.h" #include "env.h" #include "eval.h" #include "lake.h" +#include "laketest.h" #include "parse.h" void setup(void); @@ -31,13 +31,9 @@ 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 - }); + return !lt_run_tests("Eval & Apply", + (test_fn[]){test_eval, test_eval_exprs, + test_eval_exprs1, test_apply, NULL}); } void setup(void) @@ -125,10 +121,12 @@ static char *test_eval(void) LakeSym *l_bound_sym = isP; LakeSym *l_unbound_sym = sym_intern(lake, "sex"); lt_assert("bound symbol is? evaluated to null", NULL != EVAL(l_bound_sym)); - lt_assert("unbound symbol evaluated to non-null", NULL == EVAL(l_unbound_sym)); + lt_assert("unbound symbol evaluated to non-null", + NULL == EVAL(l_unbound_sym)); LakeList *l_call = list_make(); - lt_assert("empty list (nil) did not self evaluate", VAL(l_call) == EVAL(l_call)); + lt_assert("empty list (nil) did not self evaluate", + VAL(l_call) == EVAL(l_call)); LakeDottedList *l_dlist = dlist_make(list_make(), VAL(l_int)); lt_assert("dotted-list evaluated to non-null", NULL == EVAL(l_dlist)); @@ -137,7 +135,8 @@ static char *test_eval(void) LakeSym *s_x = sym_intern(lake, "x"); list_append(l_call, VAL(s_x)); list_append(l_call, VAL(l_int)); - lt_assert("define special form evaluated to non-null", NULL == EVAL(l_call)); + lt_assert("define special form evaluated to non-null", + NULL == EVAL(l_call)); lt_assert("define bound an incorrect value", VAL(l_int) == EVAL(s_x)); list_free(l_call); @@ -145,7 +144,8 @@ static char *test_eval(void) list_append(l_call, VAL(isP)); list_append(l_call, VAL(s_x)); list_append(l_call, VAL(l_int)); - lt_assert("primitive evaluated incorrectly", lake_is_true(lake, EVAL(l_call))); + lt_assert("primitive evaluated incorrectly", + lake_is_true(lake, EVAL(l_call))); list_free(l_call); return 0; @@ -175,7 +175,6 @@ static char *test_apply(void) NULL == apply(lake, fnVal, args)); list_free(args); - /* var args primitive */ fnVal = EVAL(sym_intern(lake, "+")); args = list_make(); @@ -192,7 +191,6 @@ static char *test_apply(void) 6 == INT_VAL(INT(apply(lake, fnVal, args)))); list_free(args); - /* set up a scheme function with fixed args */ eval(lake, lake->toplevel, parse_expr(lake, "(define zero? (lambda (x) (= x 0)))", 35)); @@ -212,7 +210,6 @@ static char *test_apply(void) lt_assert("function applied incorrectly", NULL == apply(lake, fnVal, args)); list_free(args); - /* set up a scheme function with only var args */ eval(lake, lake->toplevel, parse_expr(lake, "(define list (lambda rest rest))", 32)); @@ -234,7 +231,6 @@ static char *test_apply(void) NULL != apply(lake, fnVal, args)); list_free(args); - /* set up a scheme function with fixed and var args */ eval(lake, lake->toplevel, parse_expr(lake, "(define frob (lambda (a b . rest) b))", 37)); @@ -262,7 +258,6 @@ static char *test_apply(void) NULL != apply(lake, fnVal, args)); list_free(args); - /* non-function in head position */ lt_assert("apply with non-function returned non-null", NULL == apply(lake, VAL(sym), list_make())); diff --git a/test/test_fn.c b/test/test_fn.c index 47562ad..d9688b2 100644 --- a/test/test_fn.c +++ b/test/test_fn.c @@ -1,32 +1,30 @@ /** - * test_fn.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_fn.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include "laketest.h" #include "env.h" #include "eval.h" #include "lake.h" +#include "laketest.h" #include "parse.h" +#include 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 - }); + 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) { LakeList *params = list_make(); diff --git a/test/test_int.c b/test/test_int.c index bbe72c4..0a8fd5f 100644 --- a/test/test_int.c +++ b/test/test_int.c @@ -1,16 +1,16 @@ /** - * test_int.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_int.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include #include "int.h" -#include "laketest.h" #include "lake.h" +#include "laketest.h" +#include static char *test_int_make(void); static char *test_int_from_c(void); @@ -18,12 +18,8 @@ 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 - }); + return !lt_run_tests("Integers", (test_fn[]){test_int_make, test_int_from_c, + test_int_repr, NULL}); } /* LakeInt *int_make(void) */ diff --git a/test/test_lake.c b/test/test_lake.c index 10497d2..30c0f28 100644 --- a/test/test_lake.c +++ b/test/test_lake.c @@ -1,21 +1,21 @@ /** - * test_lake.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_lake.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include "laketest.h" #include "bool.h" +#include "eval.h" #include "int.h" #include "lake.h" +#include "laketest.h" +#include "parse.h" #include "str.h" #include "sym.h" -#include "eval.h" -#include "parse.h" +#include void setup(void); static char *test_lake_version(void); @@ -29,20 +29,12 @@ 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 - }); + 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(); -} +void setup(void) { lake = lake_init(); } /* #define LAKE_VERSION "0.1" */ static char *test_lake_version(void) @@ -68,10 +60,7 @@ static char *test_lake_init(void) return 0; } -static bool _is(void *a, void *b) -{ - return lake_is(VAL(a), VAL(b)); -} +static bool _is(void *a, void *b) { return lake_is(VAL(a), VAL(b)); } /* bool lake_is(LakeVal *a, LakeVal *b) */ static char *test_lake_is(void) @@ -79,7 +68,8 @@ static char *test_lake_is(void) LakeInt *i = int_from_c(42); // ints are compared by value - lt_assert("ints with equal values are not the same", _is(i, int_from_c(42))); + lt_assert("ints with equal values are not the same", + _is(i, int_from_c(42))); // nil is compared by value lt_assert("null values are not the same", _is(list_make(), list_make())); @@ -95,10 +85,7 @@ static char *test_lake_is(void) return 0; } -static bool _equal(void *a, void *b) -{ - return lake_equal(VAL(a), VAL(b)); -} +static bool _equal(void *a, void *b) { return lake_equal(VAL(a), VAL(b)); } /* bool lake_equal(LakeVal *a, LakeVal *b) */ static char *test_lake_equal(void) @@ -128,7 +115,8 @@ static char *test_lake_equal(void) LakePrimitive *pair = PRIM(lt_eval(lake, "pair?")); lt_assert("primitive is not equal to itself", _equal(null, null)); lt_assert("primitive is not equal to itself", _equal(null, null2)); - lt_assert("different primitives are equal to each other", !_equal(null, pair)); + lt_assert("different primitives are equal to each other", + !_equal(null, pair)); // functions are compared by reference LakeFn *inc = FN(lt_eval(lake, "(lambda (x) (+ x 1))")); @@ -147,8 +135,8 @@ static char *test_lake_equal(void) lt_assert("string is not equal to itself", _equal(arthur, arthur2)); lt_assert("different strings are equal", !_equal(arthur, zaphod)); - // lists are compared by value - #define S(s) VAL(lake_str_from_c(s)) +// lists are compared by value +#define S(s) VAL(lake_str_from_c(s)) LakeList *fruits = list_make(); list_append(fruits, S("mango")); list_append(fruits, S("pear")); @@ -164,8 +152,9 @@ static char *test_lake_equal(void) lt_assert("different lists are equal", !_equal(fruits, ninjas)); LakeList *fruits_copy = list_copy(fruits); - lt_assert("copy of list is not equal to original", _equal(fruits, fruits_copy)); - #undef S + lt_assert("copy of list is not equal to original", + _equal(fruits, fruits_copy)); +#undef S // dotted lists are compared by value LakeDottedList *destruction = dlist_make(fruits, VAL(ninjas)); @@ -208,7 +197,8 @@ static char *test_lake_repr(void) list_append(vals, VAL(vals)); list_append(vals, VAL(dlist_make(vals, VAL(int_from_c(4919))))); list_append(vals, eval(lake, lake->toplevel, parse_expr(lake, "null?", 5))); - list_append(vals, eval(lake, lake->toplevel, parse_expr(lake, "(lambda xs xs)", 14))); + list_append(vals, eval(lake, lake->toplevel, + parse_expr(lake, "(lambda xs xs)", 14))); list_append(vals, VAL(comment_from_c("this is a comment"))); return 0; diff --git a/test/test_list.c b/test/test_list.c index 1dd6d5c..bec077a 100644 --- a/test/test_list.c +++ b/test/test_list.c @@ -1,16 +1,16 @@ /** - * test_lake.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * test_lake.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ -#include -#include "laketest.h" #include "lake.h" +#include "laketest.h" #include "list.h" +#include void setup(void); static char *test_list_make(void); @@ -32,24 +32,13 @@ static char *test_list_repr(void); int main(int argc, char const *argv[]) { setup(); - return !lt_run_tests("List", (test_fn[]){ - test_list_make, - test_list_cons, - test_list_make_with_capacity, - test_list_from_array, - test_list_copy, - test_list_set, - test_list_append, - test_list_get, - test_list_len, - test_list_pop, - test_list_shift, - test_list_unshift, - test_list_equal, - test_list_to_str, - test_list_repr, - NULL - }); + return !lt_run_tests( + "List", (test_fn[]){test_list_make, test_list_cons, + test_list_make_with_capacity, test_list_from_array, + test_list_copy, test_list_set, test_list_append, + test_list_get, test_list_len, test_list_pop, + test_list_shift, test_list_unshift, test_list_equal, + test_list_to_str, test_list_repr, NULL}); } void setup(void) @@ -58,91 +47,46 @@ void setup(void) } /* LakeList *list_make(void) */ -static char *test_list_make(void) -{ - return 0; -} +static char *test_list_make(void) { return 0; } /* LakeList *list_cons(LakeVal *car, LakeVal *cdr) */ -static char *test_list_cons(void) -{ - return 0; -} +static char *test_list_cons(void) { return 0; } /* LakeList *list_make_with_capacity(size_t cap) */ -static char *test_list_make_with_capacity(void) -{ - return 0; -} +static char *test_list_make_with_capacity(void) { return 0; } /* LakeList *list_from_array(size_t n, LakeVal *vals[]) */ -static char *test_list_from_array(void) -{ - return 0; -} +static char *test_list_from_array(void) { return 0; } /* LakeList *list_copy(LakeList *list) */ -static char *test_list_copy(void) -{ - return 0; -} +static char *test_list_copy(void) { return 0; } /* LakeVal *list_set(LakeList *list, size_t i, LakeVal *val) */ -static char *test_list_set(void) -{ - return 0; -} +static char *test_list_set(void) { return 0; } /* LakeVal *list_append(LakeList *list, LakeVal *val) */ -static char *test_list_append(void) -{ - return 0; -} +static char *test_list_append(void) { return 0; } /* LakeVal *list_get(LakeList *list, LakeInt *li) */ -static char *test_list_get(void) -{ - return 0; -} +static char *test_list_get(void) { return 0; } /* LakeInt *list_len(LakeList *list) */ -static char *test_list_len(void) -{ - return 0; -} +static char *test_list_len(void) { return 0; } /* LakeVal *list_pop(LakeList *list) */ -static char *test_list_pop(void) -{ - return 0; -} +static char *test_list_pop(void) { return 0; } /* LakeVal *list_shift(LakeList *list) */ -static char *test_list_shift(void) -{ - return 0; -} +static char *test_list_shift(void) { return 0; } /* LakeVal *list_unshift(LakeList *list, LakeVal *val) */ -static char *test_list_unshift(void) -{ - return 0; -} +static char *test_list_unshift(void) { return 0; } /* int list_equal(LakeList *a, LakeList *b) */ -static char *test_list_equal(void) -{ - return 0; -} +static char *test_list_equal(void) { return 0; } /* LakeStr *list_to_str(LakeList *list) */ -static char *test_list_to_str(void) -{ - return 0; -} +static char *test_list_to_str(void) { return 0; } /* char *list_repr(LakeList *list) */ -static char *test_list_repr(void) -{ - return 0; -} +static char *test_list_repr(void) { return 0; } diff --git a/test/test_parse.c b/test/test_parse.c index d4a63cc..c47ef9b 100644 --- a/test/test_parse.c +++ b/test/test_parse.c @@ -1,19 +1,19 @@ #include "laketest.h" /** - * parse.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ + * parse.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_PARSE_H #define _LAKE_PARSE_H -#include #include "lake.h" +#include #define PARSE_EOF -1 #define PARSE_ERR -2 diff --git a/test/test_primitive.c b/test/test_primitive.c index e422f92..5213716 100644 --- a/test/test_primitive.c +++ b/test/test_primitive.c @@ -1,13 +1,13 @@ #include "laketest.h" -/** - * primitive.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * primitive.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_PRIMITIVE_H #define _LAKE_PRIMITIVE_H diff --git a/test/test_str.c b/test/test_str.c index 5450429..c5b6dbe 100644 --- a/test/test_str.c +++ b/test/test_str.c @@ -1,15 +1,15 @@ -/** - * test_str.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * test_str.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #include "common.h" -#include "laketest.h" #include "lake.h" +#include "laketest.h" /* LakeStr *lake_str_make(void) */ /* void lake_str_free(LakeStr *str) */ diff --git a/test/test_sym.c b/test/test_sym.c index ae4a422..3e6de9c 100644 --- a/test/test_sym.c +++ b/test/test_sym.c @@ -1,13 +1,13 @@ #include "laketest.h" -/** - * sym.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ +/** + * sym.h + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ #ifndef _LAKE_SYM_H #define _LAKE_SYM_H