mirror of
https://github.com/samsonjs/lake.git
synced 2026-03-25 08:55:49 +00:00
eradicate glib, use clang instead of gcc, tabs -> spaces
This commit is contained in:
parent
a8963b3bea
commit
5a368fbc47
42 changed files with 976 additions and 360 deletions
2
Makefile
2
Makefile
|
|
@ -7,7 +7,7 @@ liblake:
|
|||
repl:
|
||||
cd src && make repl
|
||||
|
||||
clean:
|
||||
clean: test_clean
|
||||
cd src && make clean
|
||||
-rm -f lake
|
||||
|
||||
|
|
|
|||
14
src/Makefile
14
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 $@)
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <string.h>
|
||||
#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)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_BOOL_H
|
||||
#define _LAKE_BOOL_H 1
|
||||
#define _LAKE_BOOL_H
|
||||
|
||||
#include "common.h"
|
||||
#include "lake.h"
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <string.h>
|
||||
#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));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_COMMENT_H
|
||||
#define _LAKE_COMMENT_H 1
|
||||
#define _LAKE_COMMENT_H
|
||||
|
||||
#include "common.h"
|
||||
#include "lake.h"
|
||||
|
|
|
|||
21
src/common.c
Normal file
21
src/common.c
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
/**
|
||||
* common.c
|
||||
* Lake Scheme
|
||||
*
|
||||
* Copyright 2011 Sami Samhuri
|
||||
* MIT License
|
||||
*
|
||||
*/
|
||||
|
||||
#include <stddef.h>
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
|
||||
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;
|
||||
}
|
||||
|
|
@ -8,7 +8,9 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_COMMON_H
|
||||
#define _LAKE_COMMON_H 1
|
||||
#define _LAKE_COMMON_H
|
||||
|
||||
#include <stddef.h>
|
||||
|
||||
typedef int bool;
|
||||
|
||||
|
|
@ -20,4 +22,6 @@ typedef int bool;
|
|||
#define FALSE 0
|
||||
#endif
|
||||
|
||||
char *lk_str_append(char *s1, char *s2);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
62
src/dlist.c
62
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)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_DLIST_H
|
||||
#define _LAKE_DLIST_H 1
|
||||
#define _LAKE_DLIST_H
|
||||
|
||||
#include "common.h"
|
||||
#include "lake.h"
|
||||
|
|
|
|||
13
src/env.c
13
src/env.c
|
|
@ -7,31 +7,30 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -8,14 +8,14 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_ENV_H
|
||||
#define _LAKE_ENV_H 1
|
||||
#define _LAKE_ENV_H
|
||||
|
||||
#include <glib.h>
|
||||
#include "common.h"
|
||||
#include "hash.h"
|
||||
|
||||
struct env {
|
||||
struct env *parent;
|
||||
GHashTable *bindings;
|
||||
lk_hash_t *bindings;
|
||||
};
|
||||
typedef struct env Env;
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_EVAL_H
|
||||
#define _LAKE_EVAL_H 1
|
||||
#define _LAKE_EVAL_H
|
||||
|
||||
#include "env.h"
|
||||
#include "lake.h"
|
||||
|
|
|
|||
78
src/fn.c
78
src/fn.c
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#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, ")");
|
||||
}
|
||||
|
|
|
|||
2
src/fn.h
2
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"
|
||||
|
|
|
|||
29
src/hash.c
Normal file
29
src/hash.c
Normal file
|
|
@ -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);
|
||||
}
|
||||
30
src/hash.h
Normal file
30
src/hash.h
Normal file
|
|
@ -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
|
||||
30
src/int.c
30
src/int.c
|
|
@ -7,7 +7,7 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
547
src/khash.h
Normal file
547
src/khash.h
Normal file
|
|
@ -0,0 +1,547 @@
|
|||
/* The MIT License
|
||||
|
||||
Copyright (c) 2008, 2009, 2011 by Attractive Chaos <attractor@live.co.uk>
|
||||
|
||||
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 <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <limits.h>
|
||||
|
||||
/* 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 */
|
||||
27
src/lake.c
27
src/lake.c
|
|
@ -10,17 +10,16 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#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);
|
||||
|
|
|
|||
35
src/lake.h
35
src/lake.h
|
|
@ -8,9 +8,8 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_LAKE_H
|
||||
#define _LAKE_LAKE_H 1
|
||||
#define _LAKE_LAKE_H
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#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"
|
||||
|
|
|
|||
108
src/list.c
108
src/list.c
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
|
@ -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, ")");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -8,9 +8,8 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_LIST_H
|
||||
#define _LAKE_LIST_H 1
|
||||
#define _LAKE_LIST_H
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#include "common.h"
|
||||
#include "lake.h"
|
||||
|
|
|
|||
35
src/parse.c
35
src/parse.c
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_PARSE_H
|
||||
#define _LAKE_PARSE_H 1
|
||||
#define _LAKE_PARSE_H
|
||||
|
||||
#include <stdlib.h>
|
||||
#include "lake.h"
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#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)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_PRIMITIVE_H
|
||||
#define _LAKE_PRIMITIVE_H 1
|
||||
#define _LAKE_PRIMITIVE_H
|
||||
|
||||
#include "env.h"
|
||||
#include "lake.h"
|
||||
|
|
|
|||
17
src/repl.c
17
src/repl.c
|
|
@ -11,7 +11,6 @@
|
|||
*/
|
||||
|
||||
#include <errno.h>
|
||||
#include <glib.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <sys/select.h>
|
||||
|
|
@ -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);
|
||||
|
|
|
|||
53
src/str.c
53
src/str.c
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#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);
|
||||
}
|
||||
|
|
|
|||
19
src/str.h
19
src/str.h
|
|
@ -8,19 +8,18 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_STRING_H
|
||||
#define _LAKE_STRING_H 1
|
||||
#define _LAKE_STRING_H
|
||||
|
||||
#include <glib.h>
|
||||
#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
|
||||
32
src/sym.c
32
src/sym.c
|
|
@ -7,7 +7,7 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
#ifndef _LAKE_SYM_H
|
||||
#define _LAKE_SYM_H 1
|
||||
#define _LAKE_SYM_H
|
||||
|
||||
#include "lake.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -1,28 +0,0 @@
|
|||
/**
|
||||
* symtable.c
|
||||
* Lake Scheme
|
||||
*
|
||||
* Copyright 2011 Sami Samhuri
|
||||
* MIT License
|
||||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#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);
|
||||
}
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
/**
|
||||
* symtable.h
|
||||
* Lake Scheme
|
||||
*
|
||||
* Copyright 2011 Sami Samhuri
|
||||
* MIT License
|
||||
*
|
||||
*/
|
||||
|
||||
#ifndef _LAKE_SYMTABLE_H
|
||||
#define _LAKE_SYMTABLE_H 1
|
||||
|
||||
#include <glib.h>
|
||||
#include "common.h"
|
||||
|
||||
GHashTable *symtable_make(void);
|
||||
|
||||
#endif
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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[])
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include <string.h>
|
||||
#include "common.h"
|
||||
#include "laketest.h"
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
*
|
||||
*/
|
||||
|
||||
#include <glib.h>
|
||||
#include "common.h"
|
||||
#include "laketest.h"
|
||||
#include "env.h"
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue