From 5a368fbc47ee8a5a3bcf54429ffaf42f921135d4 Mon Sep 17 00:00:00 2001 From: Sami Samhuri Date: Mon, 24 Oct 2011 21:27:53 -0700 Subject: [PATCH] eradicate glib, use clang instead of gcc, tabs -> spaces --- Makefile | 2 +- src/Makefile | 14 +- src/bool.c | 4 +- src/bool.h | 2 +- src/comment.c | 22 +- src/comment.h | 2 +- src/common.c | 21 ++ src/common.h | 6 +- src/dlist.c | 62 ++--- src/dlist.h | 2 +- src/env.c | 13 +- src/env.h | 6 +- src/eval.c | 8 +- src/eval.h | 2 +- src/fn.c | 78 +++---- src/fn.h | 2 +- src/hash.c | 29 +++ src/hash.h | 30 +++ src/int.c | 30 +-- src/int.h | 5 +- src/khash.h | 547 ++++++++++++++++++++++++++++++++++++++++++++ src/lake.c | 27 ++- src/lake.h | 35 +-- src/list.c | 108 +++++---- src/list.h | 3 +- src/parse.c | 35 ++- src/parse.h | 2 +- src/primitive.c | 8 +- src/primitive.h | 2 +- src/repl.c | 17 +- src/str.c | 53 ++--- src/str.h | 19 +- src/sym.c | 32 ++- src/sym.h | 2 +- src/symtable.c | 28 --- src/symtable.h | 18 -- test/Makefile | 19 +- test/test_comment.c | 6 +- test/test_dlist.c | 1 - test/test_env.c | 1 - test/test_eval.c | 4 +- test/test_lake.c | 29 ++- 42 files changed, 976 insertions(+), 360 deletions(-) create mode 100644 src/common.c create mode 100644 src/hash.c create mode 100644 src/hash.h create mode 100644 src/khash.h delete mode 100644 src/symtable.c delete mode 100644 src/symtable.h diff --git a/Makefile b/Makefile index 4c0635e..7b1bf44 100644 --- a/Makefile +++ b/Makefile @@ -7,7 +7,7 @@ liblake: repl: cd src && make repl -clean: +clean: test_clean cd src && make clean -rm -f lake diff --git a/src/Makefile b/src/Makefile index 6e9e8b7..f450ef5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,26 +1,26 @@ LAKE_BUILD = ../build -CC = gcc -CFLAGS := -Wall -g $(shell pkg-config --cflags glib-2.0) -LFLAGS := $(shell pkg-config --libs glib-2.0) -LAKE_OBJS = $(LAKE_BUILD)/comment.o \ +CC = clang +CFLAGS := -Wall -g +LAKE_OBJS = $(LAKE_BUILD)/common.o \ + $(LAKE_BUILD)/comment.o \ $(LAKE_BUILD)/bool.o \ $(LAKE_BUILD)/dlist.o \ $(LAKE_BUILD)/env.o \ $(LAKE_BUILD)/eval.o \ $(LAKE_BUILD)/fn.o \ + $(LAKE_BUILD)/hash.o \ $(LAKE_BUILD)/int.o \ $(LAKE_BUILD)/lake.o \ $(LAKE_BUILD)/list.o \ $(LAKE_BUILD)/parse.o \ $(LAKE_BUILD)/primitive.o \ $(LAKE_BUILD)/str.o \ - $(LAKE_BUILD)/sym.o \ - $(LAKE_BUILD)/symtable.o + $(LAKE_BUILD)/sym.o all: liblake repl repl: $(LAKE_OBJS) $(LAKE_BUILD)/repl.o - $(CC) $(CFLAGS) $(LFLAGS) $^ -o $(LAKE_BUILD)/$@ + $(CC) $(CFLAGS) $^ -o $(LAKE_BUILD)/$@ $(LAKE_BUILD)/%.o: %.c @mkdir -p $(dir $@) diff --git a/src/bool.c b/src/bool.c index a94668f..5c318d8 100644 --- a/src/bool.c +++ b/src/bool.c @@ -7,7 +7,7 @@ * */ -#include +#include #include "bool.h" #include "common.h" #include "lake.h" @@ -44,7 +44,7 @@ LakeBool *lk_bool_from_int(LakeCtx *ctx, int n) char *lk_bool_repr(LakeBool *b) { - return g_strdup(lk_bool_val(b) ? "#t" : "#f"); + return strdup(lk_bool_val(b) ? "#t" : "#f"); } LakeVal *lk_bool_and(LakeCtx *ctx, LakeVal *x, LakeVal *y) diff --git a/src/bool.h b/src/bool.h index d703d01..47583e1 100644 --- a/src/bool.h +++ b/src/bool.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_BOOL_H -#define _LAKE_BOOL_H 1 +#define _LAKE_BOOL_H #include "common.h" #include "lake.h" diff --git a/src/comment.c b/src/comment.c index e19559f..4c20e0b 100644 --- a/src/comment.c +++ b/src/comment.c @@ -7,7 +7,7 @@ * */ -#include +#include #include "common.h" #include "comment.h" #include "lake.h" @@ -15,30 +15,30 @@ static LakeComment *comment_alloc(void) { - LakeComment *comment = g_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(str_from_c(text)); + return comment_make(lk_str_from_c(text)); } char *comment_repr(LakeComment *comment) { - return g_strdup(STR_S(comment->text)); + return strndup(STR_S(comment->text), STR_N(comment->text)); } bool comment_equal(LakeComment *a, LakeComment *b) { - return str_equal(COMM_TEXT(a), COMM_TEXT(b)); + return lk_str_equal(COMM_TEXT(a), COMM_TEXT(b)); } diff --git a/src/comment.h b/src/comment.h index b8ff7f8..6d802cc 100644 --- a/src/comment.h +++ b/src/comment.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_COMMENT_H -#define _LAKE_COMMENT_H 1 +#define _LAKE_COMMENT_H #include "common.h" #include "lake.h" diff --git a/src/common.c b/src/common.c new file mode 100644 index 0000000..7168d81 --- /dev/null +++ b/src/common.c @@ -0,0 +1,21 @@ +/** + * common.c + * Lake Scheme + * + * Copyright 2011 Sami Samhuri + * MIT License + * + */ + +#include +#include +#include +#include + +char *lk_str_append(char *s1, char *s2) +{ + 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 f5125d9..1176b0e 100644 --- a/src/common.h +++ b/src/common.h @@ -8,7 +8,9 @@ */ #ifndef _LAKE_COMMON_H -#define _LAKE_COMMON_H 1 +#define _LAKE_COMMON_H + +#include typedef int bool; @@ -20,4 +22,6 @@ typedef int bool; #define FALSE 0 #endif +char *lk_str_append(char *s1, char *s2); + #endif diff --git a/src/dlist.c b/src/dlist.c index cec4b04..b5b496f 100644 --- a/src/dlist.c +++ b/src/dlist.c @@ -8,22 +8,23 @@ */ #include "dlist.h" +#include "common.h" #include "lake.h" static LakeDottedList *dlist_alloc(void) { - LakeDottedList *dlist = g_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) @@ -38,30 +39,29 @@ LakeVal *dlist_tail(LakeDottedList *dlist) char *dlist_repr(LakeDottedList *dlist) { - GString *s = g_string_new("("); - 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)); - g_string_append(s, s2); - g_free(s2); - if (i != LIST_N(dlist->head) - 1) g_string_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 = lk_str_append(s, s2); + free(s2); + if (i != LIST_N(dlist->head) - 1) s = lk_str_append(s, " "); } - else if (dlist->head) { - s2 = lake_repr(dlist->head); - g_string_append(s, s2); - g_free(s2); - } - g_string_append(s, " . "); - s2 = lake_repr(dlist->tail); - g_string_append(s, s2); - g_free(s2); - g_string_append(s, ")"); - gchar *repr = s->str; - g_string_free(s, FALSE); /* don't free char data */ - return repr; + } + else if (dlist->head) { + s2 = lake_repr(dlist->head); + s = lk_str_append(s, s2); + free(s2); + } + s = lk_str_append(s, " . "); + s2 = lake_repr(dlist->tail); + s = lk_str_append(s, s2); + free(s2); + return lk_str_append(s, ")"); } bool dlist_equal(LakeDottedList *a, LakeDottedList *b) diff --git a/src/dlist.h b/src/dlist.h index b11456b..3d027cd 100644 --- a/src/dlist.h +++ b/src/dlist.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_DLIST_H -#define _LAKE_DLIST_H 1 +#define _LAKE_DLIST_H #include "common.h" #include "lake.h" diff --git a/src/env.c b/src/env.c index 4e37032..32759e6 100644 --- a/src/env.c +++ b/src/env.c @@ -7,31 +7,30 @@ * */ -#include #include #include #include "common.h" +#include "hash.h" #include "lake.h" #include "env.h" -#include "symtable.h" Env *env_make(Env *parent) { - Env *env = g_malloc(sizeof(Env)); + Env *env = malloc(sizeof(Env)); env->parent = parent; - env->bindings = symtable_make(); + env->bindings = lk_hash_make(); return env; } Env *env_is_defined(Env *env, LakeSym *key) { - if (g_hash_table_lookup(env->bindings, key) != NULL) return env; + if (lk_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) { - g_hash_table_insert(env->bindings, key, val); + lk_hash_put(env->bindings, key->s, val); } LakeVal *env_define(Env *env, LakeSym *key, LakeVal *val) @@ -52,7 +51,7 @@ LakeVal *env_set(Env *env, LakeSym *key, LakeVal *val) LakeVal *env_get(Env *env, LakeSym *key) { - LakeVal *val = g_hash_table_lookup(env->bindings, key); + LakeVal *val = lk_hash_get(env->bindings, key->s); if (!val && env->parent) { val = env_get(env->parent, key); } diff --git a/src/env.h b/src/env.h index 009934a..a81cbbb 100644 --- a/src/env.h +++ b/src/env.h @@ -8,14 +8,14 @@ */ #ifndef _LAKE_ENV_H -#define _LAKE_ENV_H 1 +#define _LAKE_ENV_H -#include #include "common.h" +#include "hash.h" struct env { struct env *parent; - GHashTable *bindings; + lk_hash_t *bindings; }; typedef struct env Env; diff --git a/src/eval.c b/src/eval.c index 416f148..72d3b97 100644 --- a/src/eval.c +++ b/src/eval.c @@ -7,7 +7,6 @@ * */ -#include #include #include #include @@ -200,7 +199,7 @@ typedef LakeVal *(*handler)(LakeCtx *, Env *, LakeList *); static void define_handler(LakeCtx *ctx, char *name, handler fn) { - g_hash_table_insert(ctx->special_form_handlers, sym_intern(ctx, name), (void *)fn); + lk_hash_put(ctx->special_form_handlers, name, (void *)fn); } void init_special_form_handlers(LakeCtx *ctx) @@ -224,13 +223,12 @@ bool is_special_form(LakeCtx *ctx, LakeList *expr) { LakeVal *head = LIST_VAL(expr, 0); if (!lk_is_type(TYPE_SYM, head)) return FALSE; - GList *special_form_names = g_hash_table_get_keys(ctx->special_form_handlers); - return !!g_list_find(special_form_names, SYM(head)); + return lk_hash_has(ctx->special_form_handlers, SYM(head)->s); } static special_form_handler get_special_form_handler(LakeCtx *ctx, LakeSym *name) { - return (special_form_handler)g_hash_table_lookup(ctx->special_form_handlers, name); + return (special_form_handler)lk_hash_get(ctx->special_form_handlers, name->s); } static LakeVal *eval_special_form(LakeCtx *ctx, Env *env, LakeList *expr) diff --git a/src/eval.h b/src/eval.h index 2632d77..26f59b8 100644 --- a/src/eval.h +++ b/src/eval.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_EVAL_H -#define _LAKE_EVAL_H 1 +#define _LAKE_EVAL_H #include "env.h" #include "lake.h" diff --git a/src/fn.c b/src/fn.c index 41fb954..11c6342 100644 --- a/src/fn.c +++ b/src/fn.c @@ -7,7 +7,6 @@ * */ -#include #include #include "common.h" #include "env.h" @@ -16,52 +15,51 @@ static LakeFn *fn_alloc(void) { - LakeFn *fn = g_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 = fn_alloc(); - fn->params = params; - fn->varargs = varargs; - fn->body = body; - fn->closure = closure; - return fn; + fn->params = params; + fn->varargs = varargs; + fn->body = body; + fn->closure = closure; + return fn; } char *fn_repr(LakeFn *fn) { - GString *s = g_string_new("(lambda "); - char *s2; - if (LIST_N(fn->params) && fn->varargs) { - LakeDottedList *params = dlist_make(fn->params, VAL(fn->varargs)); - s2 = dlist_repr(params); - g_string_append(s, s2); - free(s2); - } - else if (fn->varargs) { - s2 = lake_repr(fn->varargs); - g_string_append(s, s2); - free(s2); - } - else { - s2 = lake_repr(fn->params); - g_string_append(s, s2); - free(s2); - } - g_string_append(s, " "); - int i; - for (i = 0; i < LIST_N(fn->body); ++i) { - s2 = lake_repr(LIST_VAL(fn->body, i)); - g_string_append(s, s2); - g_free(s2); - if (i != LIST_N(fn->body) - 1) g_string_append(s, " "); - } - g_string_append(s, ")"); - gchar *repr = s->str; - g_string_free(s, FALSE); /* don't free char data */ - return repr; + char *s = malloc(8); + s[0] = '\0'; + s = lk_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 = lk_str_append(s, s2); + free(s2); + } + else if (fn->varargs) { + s2 = lake_repr(fn->varargs); + s = lk_str_append(s, s2); + free(s2); + } + else { + s2 = lake_repr(fn->params); + s = lk_str_append(s, s2); + free(s2); + } + s = lk_str_append(s, " "); + int i; + for (i = 0; i < LIST_N(fn->body); ++i) { + s2 = lake_repr(LIST_VAL(fn->body, i)); + s = lk_str_append(s, s2); + free(s2); + if (i != LIST_N(fn->body) - 1) s = lk_str_append(s, " "); + } + return lk_str_append(s, ")"); } diff --git a/src/fn.h b/src/fn.h index 81f61aa..5490a5f 100644 --- a/src/fn.h +++ b/src/fn.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_FN_H -#define _LAKE_FN_H 1 +#define _LAKE_FN_H #include "env.h" #include "lake.h" diff --git a/src/hash.c b/src/hash.c new file mode 100644 index 0000000..dafd970 --- /dev/null +++ b/src/hash.c @@ -0,0 +1,29 @@ +/** + * 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 lk_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 *lk_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 lk_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 new file mode 100644 index 0000000..67625c0 --- /dev/null +++ b/src/hash.h @@ -0,0 +1,30 @@ +/** + * 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" + +KHASH_MAP_INIT_STR(value, void *); + +typedef khash_t(value) lk_hash_t; + +#define lk_hash_make() kh_init(value) +#define lk_hash_free(h) kh_destroy(value, h) + +bool lk_hash_has(khash_t(value) *h, char *key); +void lk_hash_put(khash_t(value) *h, char *key, void *val); +void *lk_hash_get(khash_t(value) *h, char *key); + +#endif diff --git a/src/int.c b/src/int.c index e959e7b..9707b35 100644 --- a/src/int.c +++ b/src/int.c @@ -7,7 +7,7 @@ * */ -#include +#include #include "common.h" #include "int.h" #include "lake.h" @@ -15,33 +15,35 @@ static LakeInt *int_alloc(void) { - LakeInt *i = g_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); + 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) { - return g_strdup_printf("%d", i->val); + 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 = str_from_c(s); - g_free(s); - return str; + char *s = int_repr(i); + LakeStr *str = lk_str_from_c(s); + free(s); + return str; } diff --git a/src/int.h b/src/int.h index 05ac4f5..0c0e6b7 100644 --- a/src/int.h +++ b/src/int.h @@ -8,10 +8,13 @@ */ #ifndef _LAKE_INT_H -#define _LAKE_INT_H 1 +#define _LAKE_INT_H #include "lake.h" +/* Min value of 64-bit int is −9,223,372,036,854,775,808 */ +#define MAX_INT_LENGTH 20 + LakeInt *int_make(void); LakeInt *int_from_c(int n); LakeStr *int_to_str(LakeInt *i); diff --git a/src/khash.h b/src/khash.h new file mode 100644 index 0000000..8cbc98c --- /dev/null +++ b/src/khash.h @@ -0,0 +1,547 @@ +/* The MIT License + + Copyright (c) 2008, 2009, 2011 by Attractive Chaos + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + "Software"), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be + included in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS + BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN + ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + SOFTWARE. +*/ + +/* + An example: + +#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; +} +*/ + +/* + 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: + + - 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. + + * 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): + + * Allow to declare global functions. + + 2009-09-26 (0.2.4): + + * Improve portability + + 2008-09-19 (0.2.3): + + * Corrected the example + * Improved interfaces + + 2008-09-11 (0.2.2): + + * Improved speed a little in kh_put() + + 2008-09-10 (0.2.1): + + * Added kh_clear() + * Fixed a compiling error + + 2008-09-02 (0.2.0): + + * 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. + + 2008-08-31 (0.1.1): + + * Added destructor +*/ + + +#ifndef __AC_KHASH_H +#define __AC_KHASH_H + +/*! + @header + + Generic hash table library. + */ + +#define AC_VERSION_KHASH_H "0.2.6" + +#include +#include +#include + +/* compipler specific configuration */ + +#if UINT_MAX == 0xffffffffu +typedef unsigned int khint32_t; +#elif ULONG_MAX == 0xffffffffu +typedef unsigned long khint32_t; +#endif + +#if ULONG_MAX == ULLONG_MAX +typedef unsigned long khint64_t; +#else +typedef unsigned long long khint64_t; +#endif + +#ifdef _MSC_VER +#define inline __inline +#endif + +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)) + +#ifdef KHASH_LINEAR +#define __ac_inc(k, m) 1 +#else +#define __ac_inc(k, m) (((k)>>3 ^ (k)<<3) | 1) & (m) +#endif + +#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)) +#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_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) + +/* --- BEGIN OF HASH FUNCTIONS --- */ + +/*! @function + @abstract Integer hash function + @param key The integer [khint32_t] + @return The hash value [khint_t] + */ +#define kh_int_hash_func(key) (khint32_t)(key) +/*! @function + @abstract Integer comparison function + */ +#define kh_int_hash_equal(a, b) ((a) == (b)) +/*! @function + @abstract 64-bit integer hash function + @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) +/*! @function + @abstract 64-bit integer comparison function + */ +#define kh_int64_hash_equal(a, b) ((a) == (b)) +/*! @function + @abstract const char* hash function + @param s Pointer to a null terminated string + @return The hash value + */ +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; +} +/*! @function + @abstract Another interface to const char* hash function + @param key Pointer to a null terminated string [const char*] + @return The hash value [khint_t] + */ +#define kh_str_hash_func(key) __ac_X31_hash_string(key) +/*! @function + @abstract Const char* comparison function + */ +#define kh_str_hash_equal(a, b) (strcmp(a, b) == 0) + +static inline khint_t __ac_Wang_hash(khint_t key) +{ + key += ~(key << 15); + key ^= (key >> 10); + key += (key << 3); + key ^= (key >> 6); + key += ~(key << 11); + key ^= (key >> 16); + return key; +} +#define kh_int_hash_func2(k) __ac_Wang_hash((khint_t)key) + +/* --- END OF HASH FUNCTIONS --- */ + +/* Other convenient macros... */ + +/*! + @abstract Type of the hash table. + @param name Name of the hash table [symbol] + */ +#define khash_t(name) kh_##name##_t + +/*! @function + @abstract Initiate a hash table. + @param name Name of the hash table [symbol] + @return Pointer to the hash table [khash_t(name)*] + */ +#define kh_init(name) kh_init_##name() + +/*! @function + @abstract Destroy a hash table. + @param name Name of the hash table [symbol] + @param h Pointer to the hash table [khash_t(name)*] + */ +#define kh_destroy(name, h) kh_destroy_##name(h) + +/*! @function + @abstract Reset a hash table without deallocating memory. + @param name Name of the hash table [symbol] + @param h Pointer to the hash table [khash_t(name)*] + */ +#define kh_clear(name, h) kh_clear_##name(h) + +/*! @function + @abstract Resize a hash table. + @param name Name of the hash table [symbol] + @param h Pointer to the hash table [khash_t(name)*] + @param s New size [khint_t] + */ +#define kh_resize(name, h, s) kh_resize_##name(h, s) + +/*! @function + @abstract Insert a key to the hash table. + @param name Name of the hash table [symbol] + @param h Pointer to the hash table [khash_t(name)*] + @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*] + @return Iterator to the inserted element [khint_t] + */ +#define kh_put(name, h, k, r) kh_put_##name(h, k, r) + +/*! @function + @abstract Retrieve a key from the hash table. + @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] + */ +#define kh_get(name, h, k) kh_get_##name(h, k) + +/*! @function + @abstract Remove a key from the hash table. + @param name Name of the hash table [symbol] + @param h Pointer to the hash table [khash_t(name)*] + @param k Iterator to the element to be deleted [khint_t] + */ +#define kh_del(name, h, k) kh_del_##name(h, k) + +/*! @function + @abstract Test whether a bucket contains data. + @param h Pointer to the hash table [khash_t(name)*] + @param x Iterator to the bucket [khint_t] + @return 1 if containing data; 0 otherwise [int] + */ +#define kh_exist(h, x) (!__ac_iseither((h)->flags, (x))) + +/*! @function + @abstract Get key given an iterator + @param h Pointer to the hash table [khash_t(name)*] + @param x Iterator to the bucket [khint_t] + @return Key [type of keys] + */ +#define kh_key(h, x) ((h)->keys[x]) + +/*! @function + @abstract Get value given an iterator + @param h Pointer to the hash table [khash_t(name)*] + @param x Iterator to the bucket [khint_t] + @return Value [type of values] + @discussion For hash sets, calling this results in segfault. + */ +#define kh_val(h, x) ((h)->vals[x]) + +/*! @function + @abstract Alias of kh_val() + */ +#define kh_value(h, x) ((h)->vals[x]) + +/*! @function + @abstract Get the start iterator + @param h Pointer to the hash table [khash_t(name)*] + @return The start iterator [khint_t] + */ +#define kh_begin(h) (khint_t)(0) + +/*! @function + @abstract Get the end iterator + @param h Pointer to the hash table [khash_t(name)*] + @return The end iterator [khint_t] + */ +#define kh_end(h) ((h)->n_buckets) + +/*! @function + @abstract Get the number of elements in the hash table + @param h Pointer to the hash table [khash_t(name)*] + @return Number of elements in the hash table [khint_t] + */ +#define kh_size(h) ((h)->size) + +/*! @function + @abstract Get the number of buckets in the hash table + @param h Pointer to the hash table [khash_t(name)*] + @return Number of buckets in the hash table [khint_t] + */ +#define kh_n_buckets(h) ((h)->n_buckets) + +/* More conenient interfaces */ + +/*! @function + @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) + +/*! @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) + +/*! @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) + +/*! @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) + +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) + +/*! @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) + +#endif /* __AC_KHASH_H */ \ No newline at end of file diff --git a/src/lake.c b/src/lake.c index 7a1106e..ce514c6 100644 --- a/src/lake.c +++ b/src/lake.c @@ -10,17 +10,16 @@ * */ -#include #include "bool.h" #include "comment.h" #include "common.h" +#include "hash.h" #include "env.h" #include "eval.h" #include "lake.h" #include "list.h" #include "primitive.h" #include "str.h" -#include "symtable.h" int lk_val_size(void *x) { @@ -34,7 +33,7 @@ int lk_is_type(LakeType t, void *x) char *lake_repr(void *expr) { - if (expr == NULL) return g_strdup("(null)"); + if (expr == NULL) return strdup("(null)"); char *s = NULL; @@ -53,12 +52,16 @@ char *lake_repr(void *expr) s = int_repr(INT(e)); break; - case TYPE_STR: - s = g_strdup_printf("\"%s\"", STR_S(STR(e))); + case TYPE_STR: { + size_t n = strlen(STR_S(STR(e))) + 2; + s = malloc(n); + /* TODO: quote the string */ + snprintf(s, n, "\"%s\"", STR_S(STR(e))); break; + } case TYPE_LIST: - s = list_repr(LIST(e)); + s = list_repr(LIST(e)); break; case TYPE_DLIST: @@ -82,7 +85,7 @@ char *lake_repr(void *expr) // so go ahead and print out the size too. fprintf(stderr, "error: unrecognized value, type %d, size %zu bytes", e->type, e->size); - s = g_strdup("(unknown)"); + s = strdup("(unknown)"); } return s; @@ -128,7 +131,7 @@ bool lake_equal(LakeVal *a, LakeVal *b) return INT_VAL(INT(a)) == INT_VAL(INT(b)); case TYPE_STR: - return str_equal(STR(a), STR(b)); + return lk_str_equal(STR(a), STR(b)); case TYPE_LIST: return list_equal(LIST(a), LIST(b)); @@ -147,7 +150,7 @@ bool lake_equal(LakeVal *a, LakeVal *b) static LakeBool *bool_make(bool val) { - LakeBool *b = g_malloc(sizeof(LakeBool)); + LakeBool *b = malloc(sizeof(LakeBool)); VAL(b)->type = TYPE_BOOL; VAL(b)->size = sizeof(LakeBool); b->val = val; @@ -156,10 +159,10 @@ static LakeBool *bool_make(bool val) LakeCtx *lake_init(void) { - LakeCtx *ctx = g_malloc(sizeof(LakeCtx)); + LakeCtx *ctx = malloc(sizeof(LakeCtx)); ctx->toplevel = env_make(NULL); - ctx->symbols = g_hash_table_new(g_str_hash, g_str_equal); - ctx->special_form_handlers = symtable_make(); + ctx->symbols = lk_hash_make(); + ctx->special_form_handlers = lk_hash_make(); ctx->T = bool_make(TRUE); ctx->F = bool_make(FALSE); bind_primitives(ctx); diff --git a/src/lake.h b/src/lake.h index 2687004..65a03cd 100644 --- a/src/lake.h +++ b/src/lake.h @@ -8,9 +8,8 @@ */ #ifndef _LAKE_LAKE_H -#define _LAKE_LAKE_H 1 +#define _LAKE_LAKE_H -#include #include #include "common.h" @@ -54,8 +53,8 @@ struct lake_sym { typedef struct lake_sym LakeSym; struct lake_bool { - LakeVal base; - bool val; + LakeVal base; + bool val; }; typedef struct lake_bool LakeBool; @@ -90,19 +89,20 @@ typedef struct lake_list LakeList; #define LIST_VAL(list, i) (i >= 0 && i < list->n ? list->vals[i] : NULL) struct lake_dlist { - LakeVal base; - LakeList *head; - LakeVal *tail; + LakeVal base; + LakeList *head; + LakeVal *tail; }; typedef struct lake_dlist LakeDottedList; +#include "hash.h" #include "env.h" /* Execution context */ struct lake_ctx { Env *toplevel; - GHashTable *symbols; - GHashTable *special_form_handlers; + lk_hash_t *symbols; + lk_hash_t *special_form_handlers; LakeBool *T; LakeBool *F; }; @@ -111,10 +111,10 @@ typedef struct lake_ctx LakeCtx; typedef LakeVal *(*lake_prim)(LakeCtx *ctx, LakeList *args); struct lake_primitive { - LakeVal base; - char *name; + LakeVal base; + char *name; int arity; - lake_prim fn; + lake_prim fn; }; typedef struct lake_primitive LakePrimitive; @@ -123,11 +123,11 @@ typedef struct lake_primitive LakePrimitive; struct lake_fn { - LakeVal base; - LakeList *params; - LakeSym *varargs; - LakeList *body; - Env *closure; + LakeVal base; + LakeList *params; + LakeSym *varargs; + LakeList *body; + Env *closure; }; typedef struct lake_fn LakeFn; @@ -160,6 +160,7 @@ char *lake_repr(void *val); #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" diff --git a/src/list.c b/src/list.c index ba40152..cd92a5a 100644 --- a/src/list.c +++ b/src/list.c @@ -7,7 +7,6 @@ * */ -#include #include #include #include @@ -23,7 +22,7 @@ static LakeList *list_alloc(void) { - LakeList *list = g_malloc(sizeof(LakeList)); + LakeList *list = malloc(sizeof(LakeList)); VAL(list)->type = TYPE_LIST; VAL(list)->size = sizeof(LakeList); return list; @@ -31,10 +30,10 @@ static LakeList *list_alloc(void) void list_free(LakeList *list) { - /* TODO: proper memory management ... refcounting? */ - if (list) { - g_free(list); - } + /* TODO: proper memory management ... refcounting? */ + if (list) { + free(list); + } } LakeList *list_make(void) @@ -64,7 +63,7 @@ LakeList *list_make_with_capacity(size_t cap) LakeList *list = list_alloc(); list->cap = cap; list->n = 0; - list->vals = g_malloc(cap * sizeof(LakeVal *)); + list->vals = malloc(cap * sizeof(LakeVal *)); return list; } @@ -89,13 +88,13 @@ LakeList *list_copy(LakeList *list) static void list_grow(LakeList *list) { list->cap *= 2; - list->vals = g_realloc(list->vals, list->cap * sizeof(LakeVal *)); + 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 >= 0 && i < list->n) { + if (i < list->n) { list->vals[i] = val; } return NULL; @@ -121,45 +120,45 @@ LakeVal *list_append(LakeList *list, LakeVal *val) 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]; - } - list->n--; - } - return head; + 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--; + } + return head; } LakeVal *list_unshift(LakeList *list, LakeVal *val) { - if (list->n == 0) { + if (list->n == 0) { list_append(list, val); } else { if (list->n >= list->cap) { list_grow(list); } - size_t i = list->n++; - do { - list->vals[i] = list->vals[i - 1]; + size_t i = list->n++; + do { + list->vals[i] = list->vals[i - 1]; } while (i--); list->vals[0] = val; - } - return NULL; + } + 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) @@ -176,32 +175,31 @@ bool list_equal(LakeList *a, LakeList *b) LakeStr *list_to_str(LakeList *list) { - char *s = list_repr(list); - LakeStr *str = str_from_c(s); - g_free(s); - return str; + char *s = list_repr(list); + LakeStr *str = lk_str_from_c(s); + free(s); + return str; } char *list_repr(LakeList *list) { - GString *s = g_string_new("("); - int i; - char *s2; - LakeVal *val; - for (i = 0; i < LIST_N(list); ++i) { - val = LIST_VAL(list, i); - if (val == VAL(list)) { - s2 = g_strdup("[Circular]"); - } - else { - s2 = lake_repr(val); - } - g_string_append(s, s2); - g_free(s2); - if (i != LIST_N(list) - 1) g_string_append(s, " "); + 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]"); } - g_string_append(s, ")"); - gchar *repr = s->str; - g_string_free(s, FALSE); /* don't free char data */ - return repr; + else { + s2 = lake_repr(val); + } + s = lk_str_append(s, s2); + free(s2); + if (i != LIST_N(list) - 1) s = lk_str_append(s, " "); + } + return lk_str_append(s, ")"); } diff --git a/src/list.h b/src/list.h index a192b9d..57a6e58 100644 --- a/src/list.h +++ b/src/list.h @@ -8,9 +8,8 @@ */ #ifndef _LAKE_LIST_H -#define _LAKE_LIST_H 1 +#define _LAKE_LIST_H -#include #include #include "common.h" #include "lake.h" diff --git a/src/parse.c b/src/parse.c index 2f28d6c..a1ff221 100644 --- a/src/parse.c +++ b/src/parse.c @@ -7,7 +7,6 @@ * */ -#include #include #include #include @@ -163,7 +162,7 @@ static char *parse_while(Ctx *ctx, bool (*is_valid)(char)) { size_t n = 8; size_t i = 0; - char *s = g_malloc(n); + char *s = malloc(n); char c; while ((c = peek(ctx)) != PARSE_EOF && is_valid(c)) { s[i++] = c; @@ -171,7 +170,7 @@ static char *parse_while(Ctx *ctx, bool (*is_valid)(char)) /* grow if necessary */ if (i >= n) { n *= 2; - if (!(s = g_realloc(s, n))) OOM(); + if (!(s = realloc(s, n))) OOM(); } } s[i] = '\0'; @@ -215,7 +214,7 @@ static LakeVal *parse_int(Ctx *ctx) static LakeVal *parse_sym(Ctx *ctx) { - LakeVal *val; + LakeVal *val; static int size = 1024; char s[size]; char c; @@ -225,15 +224,15 @@ static LakeVal *parse_sym(Ctx *ctx) consume1(ctx); } s[i] = '\0'; - if (g_strcmp0(s, "#t") == 0) { - val = VAL(ctx->lake_ctx->T); - } - else if (g_strcmp0(s, "#f") == 0) { - val = VAL(ctx->lake_ctx->F); - } - else { - val = VAL(sym_intern(ctx->lake_ctx, s)); - } + 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; } @@ -265,7 +264,7 @@ static LakeVal *parse_str(Ctx *ctx) { size_t n = 8; size_t i = 0; - char *s = g_malloc(n); + char *s = malloc(n); char c; ch(ctx, '"'); while ((c = peek(ctx)) != PARSE_EOF && c != '"') { @@ -280,13 +279,13 @@ static LakeVal *parse_str(Ctx *ctx) /* grow if necessary */ if (i >= n) { n *= 2; - if (!(s = g_realloc(s, n))) OOM(); + if (!(s = realloc(s, n))) OOM(); } } s[i] = '\0'; ch(ctx, '"'); - LakeStr *str = str_from_c(s); - g_free(s); + LakeStr *str = lk_str_from_c(s); + free(s); return VAL(str); } @@ -347,7 +346,7 @@ static LakeVal *parse_comment(Ctx *ctx) { char *text = parse_while(ctx, is_not_newline); LakeComment *comment = comment_from_c(text); - g_free(text); + free(text); return VAL(comment); } diff --git a/src/parse.h b/src/parse.h index 92a84df..25d85c4 100644 --- a/src/parse.h +++ b/src/parse.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_PARSE_H -#define _LAKE_PARSE_H 1 +#define _LAKE_PARSE_H #include #include "lake.h" diff --git a/src/primitive.c b/src/primitive.c index 3ba702e..57a5334 100644 --- a/src/primitive.c +++ b/src/primitive.c @@ -7,7 +7,6 @@ * */ -#include #include #include "bool.h" #include "common.h" @@ -33,7 +32,7 @@ static LakePrimitive *prim_alloc(void) LakePrimitive *prim_make(char *name, int arity, lake_prim fn) { LakePrimitive *prim = prim_alloc(); - prim->name = g_strdup(name); + prim->name = strdup(name); prim->arity = arity; prim->fn = fn; return prim; @@ -41,7 +40,10 @@ LakePrimitive *prim_make(char *name, int arity, lake_prim fn) char *prim_repr(LakePrimitive *prim) { - return g_strdup_printf("<#primitive:%s(%d)>", prim->name, prim->arity); + 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) diff --git a/src/primitive.h b/src/primitive.h index 5aba665..40e9467 100644 --- a/src/primitive.h +++ b/src/primitive.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_PRIMITIVE_H -#define _LAKE_PRIMITIVE_H 1 +#define _LAKE_PRIMITIVE_H #include "env.h" #include "lake.h" diff --git a/src/repl.c b/src/repl.c index 19a97ba..daaf5cf 100644 --- a/src/repl.c +++ b/src/repl.c @@ -11,7 +11,6 @@ */ #include -#include #include #include #include @@ -49,11 +48,11 @@ static LakeVal *prompt_read(LakeCtx *ctx, Env *env, char *prompt) } return NULL; } - /* trim the newline if any */ - buf[strcspn(buf, "\n")] = '\0'; + /* trim the newline if any */ + buf[strcspn(buf, "\n")] = '\0'; - /* parse list expressions */ - if (first_char(buf) == '(') { + /* parse list expressions */ + if (first_char(buf) == '(') { return parse_expr(ctx, buf, strlen(buf)); } @@ -108,13 +107,13 @@ static char *read_file(char const *filename) size_t n = size; size_t i = 0; size_t read; - char *s = g_malloc(n); + char *s = malloc(n); while (!feof(fp) && !ferror(fp)) { read = fread(buf, 1, size, fp); if (i + read > n) { n += size; - if (!(s = g_realloc(s, n))) OOM(); + if (!(s = realloc(s, n))) OOM(); } memcpy(s + i, buf, read); i += read; @@ -140,10 +139,10 @@ int main (int argc, char const *argv[]) LakeCtx *ctx = lake_init(); /* create and bind args */ - LakeVal **argVals = g_malloc(argc * sizeof(LakeVal *)); + LakeVal **argVals = malloc(argc * sizeof(LakeVal *)); int i; for (i = 0; i < argc; ++i) { - argVals[i] = VAL(str_from_c((char *)argv[i])); + argVals[i] = VAL(lk_str_from_c((char *)argv[i])); } LakeList *args = list_from_array(argc, argVals); free(argVals); diff --git a/src/str.c b/src/str.c index 7b0501f..f1b7030 100644 --- a/src/str.c +++ b/src/str.c @@ -7,7 +7,6 @@ * */ -#include #include #include #include "common.h" @@ -15,62 +14,64 @@ #include "lake.h" #include "str.h" -static LakeStr *str_alloc(void) +#define MIN(a, b) ((a) < (b) ? (a) : (b)) + +static LakeStr *lk_str_alloc(void) { - LakeStr *str = g_malloc(sizeof(LakeStr)); + LakeStr *str = malloc(sizeof(LakeStr)); VAL(str)->type = TYPE_STR; VAL(str)->size = sizeof(LakeStr); return str; } -void str_free(LakeStr *str) +void lk_str_free(LakeStr *str) { - g_free(str->s); - g_free(str); + free(STR_S(str)); + free(str); } -static LakeVal *str_set(LakeStr *str, char *s) +static LakeVal *lk_str_set(LakeStr *str, char *s) { - str->n = strlen(s); - str->s = g_strdup(s); + STR_N(str) = strlen(s); + STR_S(str) = strndup(s, STR_N(str)); return NULL; } -LakeStr *str_from_c(char *s) +LakeStr *lk_str_from_c(char *s) { - LakeStr *str = str_alloc(); - str_set(str, s); + LakeStr *str = lk_str_alloc(); + lk_str_set(str, s); return str; } -LakeStr *str_make(void) +LakeStr *lk_str_make(void) { - return str_from_c(""); + return lk_str_from_c(""); } -LakeInt *str_len(LakeStr *str) +LakeInt *lk_str_len(LakeStr *str) { - return int_from_c(str->n); + return int_from_c(STR_N(str)); } -LakeStr *str_copy(LakeStr *str) +LakeStr *lk_str_copy(LakeStr *str) { - return str_from_c(str->s); + return lk_str_from_c(STR_S(str)); } -char *str_val(LakeStr *str) +char *lk_str_val(LakeStr *str) { - return g_strdup(str->s); + return strndup(STR_S(str), STR_N(str)); } -bool str_equal(LakeStr *a, LakeStr *b) +bool lk_str_equal(LakeStr *a, LakeStr *b) { - size_t n = STR_N(a); - if (n != STR_N(b)) return FALSE; - return g_strcmp0(a->s, b->s) == 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 *str_to_str(LakeStr *str) +LakeStr *lk_str_to_str(LakeStr *str) { - return str_copy(str); + return lk_str_copy(str); } diff --git a/src/str.h b/src/str.h index 15e1adb..359b495 100644 --- a/src/str.h +++ b/src/str.h @@ -8,19 +8,18 @@ */ #ifndef _LAKE_STRING_H -#define _LAKE_STRING_H 1 +#define _LAKE_STRING_H -#include #include "common.h" #include "lake.h" -LakeStr *str_make(void); -void str_free(LakeStr *str); -LakeStr *str_copy(LakeStr *str); -LakeStr *str_from_c(char *s); -char *str_val(LakeStr *str); -LakeInt *str_len(LakeStr *str); -bool str_equal(LakeStr *a, LakeStr *b); -LakeStr *str_to_str(LakeStr *str); +LakeStr *lk_str_make(void); +void lk_str_free(LakeStr *str); +LakeStr *lk_str_copy(LakeStr *str); +LakeStr *lk_str_from_c(char *s); +char *lk_str_val(LakeStr *str); +LakeInt *lk_str_len(LakeStr *str); +bool lk_str_equal(LakeStr *a, LakeStr *b); +LakeStr *lk_str_to_str(LakeStr *str); #endif \ No newline at end of file diff --git a/src/sym.c b/src/sym.c index 6f319a2..b021181 100644 --- a/src/sym.c +++ b/src/sym.c @@ -7,7 +7,7 @@ * */ -#include +#include #include #include #include @@ -17,9 +17,23 @@ #include "str.h" #include "sym.h" +/* 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; + + while ((c = *s++)) + h = ((h << 5) + h) ^ c; + + return h; +} + static LakeSym *sym_alloc(void) { - LakeSym *sym = g_malloc(sizeof(LakeSym)); + LakeSym *sym = malloc(sizeof(LakeSym)); VAL(sym)->type = TYPE_SYM; VAL(sym)->size = sizeof(LakeSym); return sym; @@ -27,20 +41,20 @@ static LakeSym *sym_alloc(void) LakeSym *sym_intern(LakeCtx *ctx, char *s) { - LakeSym *sym = g_hash_table_lookup(ctx->symbols, s); + LakeSym *sym = lk_hash_get(ctx->symbols, s); if (!sym) { sym = sym_alloc(); sym->n = strlen(s); - sym->s = g_strdup(s); - sym->hash = g_str_hash(s); - g_hash_table_insert(ctx->symbols, sym->s, sym); - } + sym->s = strndup(s, sym->n); + sym->hash = str_hash(s); + lk_hash_put(ctx->symbols, sym->s, sym); + } return sym; } LakeStr *sym_to_str(LakeSym *sym) { - return str_from_c(sym->s); + return lk_str_from_c(sym->s); } LakeSym *sym_from_str(LakeCtx *ctx, LakeStr *str) @@ -50,7 +64,7 @@ LakeSym *sym_from_str(LakeCtx *ctx, LakeStr *str) char *sym_repr(LakeSym *sym) { - return g_strdup(sym->s); + return strndup(sym->s, sym->n); } unsigned long sym_val(LakeSym *sym) diff --git a/src/sym.h b/src/sym.h index d46ccc7..fcc7e69 100644 --- a/src/sym.h +++ b/src/sym.h @@ -8,7 +8,7 @@ */ #ifndef _LAKE_SYM_H -#define _LAKE_SYM_H 1 +#define _LAKE_SYM_H #include "lake.h" diff --git a/src/symtable.c b/src/symtable.c deleted file mode 100644 index c1e9c10..0000000 --- a/src/symtable.c +++ /dev/null @@ -1,28 +0,0 @@ -/** - * symtable.c - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ - -#include -#include "common.h" -#include "lake.h" -#include "symtable.h" - -static guint _sym_hash(gconstpointer key) -{ - return sym_val(SYM(key)); -} - -static bool _sym_eq(gconstpointer a, gconstpointer b) -{ - return a == b; -} - -GHashTable *symtable_make(void) -{ - return g_hash_table_new(_sym_hash, _sym_eq); -} diff --git a/src/symtable.h b/src/symtable.h deleted file mode 100644 index b7728ae..0000000 --- a/src/symtable.h +++ /dev/null @@ -1,18 +0,0 @@ -/** - * symtable.h - * Lake Scheme - * - * Copyright 2011 Sami Samhuri - * MIT License - * - */ - -#ifndef _LAKE_SYMTABLE_H -#define _LAKE_SYMTABLE_H 1 - -#include -#include "common.h" - -GHashTable *symtable_make(void); - -#endif \ No newline at end of file diff --git a/test/Makefile b/test/Makefile index 6aeebb7..6e1b14d 100644 --- a/test/Makefile +++ b/test/Makefile @@ -1,6 +1,5 @@ -CC = gcc -CFLAGS := -Wall -g -I../src $(shell pkg-config --cflags glib-2.0) -LFLAGS := $(shell pkg-config --libs glib-2.0) +CC = clang +CFLAGS := -Wall -g -I../src OBJS = ../build/liblake.a TESTS = test_comment test_dlist test_env test_eval test_fn test_int test_lake @@ -13,25 +12,25 @@ all: $(TESTS) test: all test_comment: laketest.o test_comment.o - $(CC) $(CFLAGS) $(LFLAGS) $^ $(OBJS) -o $@ + $(CC) $(CFLAGS) $^ $(OBJS) -o $@ test_dlist: laketest.o test_dlist.o - $(CC) $(CFLAGS) $(LFLAGS) $^ $(OBJS) -o $@ + $(CC) $(CFLAGS) $^ $(OBJS) -o $@ test_env: laketest.o test_env.o - $(CC) $(CFLAGS) $(LFLAGS) $^ $(OBJS) -o $@ + $(CC) $(CFLAGS) $^ $(OBJS) -o $@ test_eval: laketest.o test_eval.o - $(CC) $(CFLAGS) $(LFLAGS) $^ $(OBJS) -o $@ + $(CC) $(CFLAGS) $^ $(OBJS) -o $@ test_fn: laketest.o test_fn.o - $(CC) $(CFLAGS) $(LFLAGS) $^ $(OBJS) -o $@ + $(CC) $(CFLAGS) $^ $(OBJS) -o $@ test_int: laketest.o test_int.o - $(CC) $(CFLAGS) $(LFLAGS) $^ $(OBJS) -o $@ + $(CC) $(CFLAGS) $^ $(OBJS) -o $@ test_lake: laketest.o test_lake.o - $(CC) $(CFLAGS) $(LFLAGS) $^ $(OBJS) -o $@ + $(CC) $(CFLAGS) $^ $(OBJS) -o $@ clean: -rm -f *.o $(TESTS) diff --git a/test/test_comment.c b/test/test_comment.c index 62211cd..9401615 100644 --- a/test/test_comment.c +++ b/test/test_comment.c @@ -23,7 +23,7 @@ static char *test_comment_make(void) LakeComment *comment = comment_make(text); lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment)); lt_assert("value size is incorrect", lk_val_size(comment) == sizeof(LakeComment)); - lt_assert("comment text is incorrect", str_equal(text, COMM_TEXT(comment))); + lt_assert("comment text is incorrect", lk_str_equal(text, COMM_TEXT(comment))); return 0; } @@ -33,7 +33,7 @@ static char *test_comment_from_c(void) LakeComment *comment = comment_from_c(TEXT); lt_assert("type is not TYPE_COMM", lk_is_type(TYPE_COMM, comment)); lt_assert("value size is incorrect", lk_val_size(comment) == sizeof(LakeComment)); - lt_assert("comment text is incorrect", str_equal(text, COMM_TEXT(comment))); + lt_assert("comment text is incorrect", lk_str_equal(text, COMM_TEXT(comment))); return 0; } @@ -60,7 +60,7 @@ static char *test_comment_equal(void) void setup(void) { - text = str_from_c(TEXT); + text = lk_str_from_c(TEXT); } int main(int argc, char const *argv[]) diff --git a/test/test_dlist.c b/test/test_dlist.c index e6f323c..df4f06c 100644 --- a/test/test_dlist.c +++ b/test/test_dlist.c @@ -7,7 +7,6 @@ * */ -#include #include #include "common.h" #include "laketest.h" diff --git a/test/test_env.c b/test/test_env.c index 7e1a110..bec0a34 100644 --- a/test/test_env.c +++ b/test/test_env.c @@ -7,7 +7,6 @@ * */ -#include #include "common.h" #include "laketest.h" #include "env.h" diff --git a/test/test_eval.c b/test/test_eval.c index 9f5c832..b66a633 100644 --- a/test/test_eval.c +++ b/test/test_eval.c @@ -89,7 +89,7 @@ static char *test_eval(void) LakeBool *l_bool = lake->T; LakeInt *l_int = int_from_c(42); - LakeStr *l_str = str_from_c("i am the walrus"); + LakeStr *l_str = lk_str_from_c("i am the walrus"); lt_assert("bool does not self evaluate", VAL(l_bool) == EVAL(l_bool)); lt_assert("int does not self evaluate", VAL(l_int) == EVAL(l_int)); lt_assert("string does not self evaluate", VAL(l_str) == EVAL(l_str)); @@ -118,7 +118,7 @@ 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", IS_TRUE(lake, EVAL(l_call))); + lt_assert("primitive evaluated incorrectly", lk_is_true(lake, EVAL(l_call))); list_free(l_call); return 0; diff --git a/test/test_lake.c b/test/test_lake.c index 6ba2b72..47a8770 100644 --- a/test/test_lake.c +++ b/test/test_lake.c @@ -14,6 +14,8 @@ #include "lake.h" #include "str.h" #include "sym.h" +#include "eval.h" +#include "parse.h" static LakeCtx *lake; @@ -78,7 +80,7 @@ static char *test_lake_equal(void) { LakeInt *i = int_from_c(42); LakeInt *j = int_from_c(42); - LakeStr *arthur = str_from_c("arthur"); + LakeStr *arthur = lk_str_from_c("arthur"); // values with different types are never equal lt_assert("values with different types are equal", !_equal(i, arthur)); @@ -114,14 +116,14 @@ static char *test_lake_equal(void) lt_assert("int is not equal to itself", _equal(i, i)); // strings are compared by value - LakeStr *arthur2 = str_from_c("arthur"); - LakeStr *zaphod = str_from_c("zaphod"); + LakeStr *arthur2 = lk_str_from_c("arthur"); + LakeStr *zaphod = lk_str_from_c("zaphod"); lt_assert("string is not equal to itself", _equal(arthur, arthur)); lt_assert("string is not equal to itself", _equal(arthur, arthur2)); lt_assert("different strings are equal", !_equal(arthur, zaphod)); // lists are compared by value - #define S(s) VAL(str_from_c(s)) + #define S(s) VAL(lk_str_from_c(s)) LakeList *fruits = list_make(); list_append(fruits, S("mango")); list_append(fruits, S("pear")); @@ -166,7 +168,24 @@ static char *test_lake_equal(void) /* char *lake_repr(LakeVal *val) */ static char *test_lake_repr(void) { - /* TODO */ + lt_assert("repr of NULL is not (null)", + strncmp(lake_repr(NULL), "(null)", 6) == 0); + lt_assert("repr of unknown value is not (unknown)", + strncmp(lake_repr(NULL), "(null)", 6) == 0); + + // In every other case reading the the string returned by lake_repr should + // result in a value equal to the original passed to lake_repr. + LakeList *vals = list_make(); + list_append(vals, VAL(sym_intern(lake, "symbol"))); + list_append(vals, VAL(lk_str_from_c("string"))); + list_append(vals, VAL(lk_bool_from_int(lake, TRUE))); + list_append(vals, VAL(int_from_c(42))); + 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, VAL(comment_from_c("this is a comment"))); + return 0; }