first commit

.gitignore

@@ -0,0 +1,2 @@
+*.o
+lake

Makefile

@@ -0,0 +1,8 @@
+CC=gcc -Wall -ansi -G
+
+all: lake
+
+lake: lake.o env.o hashtab.o int.o string.o sym.o parse.o bool.o list.o
+
+clean:
+	rm *.o lake

bool.c

@@ -0,0 +1,28 @@
+#include "bool.h"
+#include "lake.h"
+#include "sym.h"
+
+LakeSym *bool_from_int(int n)
+{
+    return n ? sym_intern("#t") : sym_intern("#f");
+}
+
+int is_true(LakeVal *val)
+{
+    return (val->type == TYPE_SYM && sym_eq(sym_intern("#t"), SYM(val)));
+}
+
+int is_false(LakeVal *val)
+{
+    return (val->type == TYPE_SYM && sym_eq(sym_intern("#f"), SYM(val)));
+}
+
+int is_truthy(LakeVal *val)
+{
+    return is_true(val); /* TODO */
+}
+
+int is_falsy(LakeVal *val)
+{
+    return is_false(val); /* TODO */
+}

bool.h

@@ -0,0 +1,12 @@
+#ifndef _BOOL_H
+#define _BOOL_H 1
+
+#include "lake.h"
+
+LakeSym *bool_from_int(int b);
+int is_true(LakeVal *val);
+int is_false(LakeVal *val);
+int is_truthy(LakeVal *val);
+int is_falsy(LakeVal *val);
+
+#endif

env.c

@@ -0,0 +1,107 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "lake.h"
+#include "env.h"
+#include "hashtab.h"
+
+#define ENV_TABLE_SIZE 64
+#define SYM_TABLE_SIZE 1024
+
+static Env *_shared = NULL;
+
+void set_shared_env(Env *env)
+{
+    _shared = env;
+}
+
+Env *shared_env(void)
+{
+    if (!_shared) {
+        _shared = env_make(NULL);
+    }
+    return _shared;
+}
+
+Env *env_make(Env *parent)
+{
+    Env *env;
+    env = malloc(sizeof(Env));
+    if (!env) oom();
+    env->parent = parent;
+    env->bindings = ht_init(ENV_TABLE_SIZE, NULL);
+    env->symbols = ht_init(SYM_TABLE_SIZE, NULL);
+    return env;
+}
+
+LakeVal *env_define(Env *env, char *key, LakeVal *val)
+{
+    size_t keylen = strlen(key);
+    if (ht_get(env->bindings, key, keylen) != NULL)
+        return NULL;
+    
+    return VAL_OR_NIL(ht_put(env->bindings, key, keylen, val, VAL_SIZE(val)));
+}
+
+LakeVal *env_set(Env *env, char *key, LakeVal *val)
+{
+    size_t keylen = strlen(key);
+    if (ht_get(env->bindings, key, keylen) == NULL)
+        return NULL;
+
+    return VAL_OR_NIL(ht_put(env->bindings, key, keylen, val, VAL_SIZE(val)));
+}
+
+LakeVal *env_get(Env *env, char *key)
+{
+    return VAL_OR_NIL(ht_get(env->bindings, key, strlen(key)));
+}
+
+int env_is_bound(Env *env, char *key)
+{
+    return (ht_get(env->bindings, key, strlen(key)) != NULL);
+}
+
+/*
+LakeVal *env_apply(Env *env, LakeFn *fn, LakeList *args)
+{
+    return NIL;
+}
+*/
+
+LakeVal *env_eval(Env *env, LakeVal *expr)
+{
+    LakeVal *result;
+    LakeList *list;
+    
+    switch (expr->type) {
+
+    /* self evaluating types */
+    case TYPE_NIL:
+    case TYPE_SYM:
+    case TYPE_BOOL:
+    case TYPE_INT:
+    case TYPE_STR:
+        result = expr;
+        break;
+
+    case TYPE_LIST:
+        list = LIST(expr);
+        if (LIST_N(list) == 0) {
+            result = NIL;
+        } else {
+            /*
+            LakeFn *fn = list_shift(list);
+            result = env_apply(env, fn, list);
+            */
+            printf("%s:%d TODO apply functions\n", __FILE__, __LINE__);
+            result = expr;
+        }
+        break;
+        
+    default:
+        printf("unrecognized value, type %d, size %lu bytes", expr->type, expr->size);
+        die("we don't eval that around here!");
+    }
+    
+    return result;
+}

env.h

@@ -0,0 +1,25 @@
+#ifndef _ENV_H
+#define _ENV_H 1
+
+#include "hashtab.h"
+
+struct env {
+    struct env *parent;
+    hashtab_t *bindings;
+    hashtab_t *symbols;
+};
+typedef struct env Env;
+
+#include "lake.h"
+
+void set_shared_env(Env *env);
+Env *shared_env(void);
+
+Env *env_make(Env *parent);
+LakeVal *env_define(Env *env, char *key, LakeVal *val);
+LakeVal *env_set(Env *env, char *key, LakeVal *val);
+LakeVal *env_get(Env *env, char *key);
+int env_is_bound(Env *env, char *key);
+LakeVal *env_eval(Env *env, LakeVal *expr);
+
+#endif

hashtab.c

@@ -0,0 +1,310 @@
+/* hashtab.c - Simple, Reliable C Hashtable
+* Copyright (C) 2007 Christopher Wellons <mosquitopsu@gmail.com>
+*
+* This program is free software; you can redistribute it and/or
+* modify it under the terms of the GNU General Public License as
+* published by the Free Software Foundation; either version 2 of the
+* License, or (at your option) any later version.
+*
+* This program is distributed in the hope that it will be useful, but
+* WITHOUT ANY WARRANTY; without even the implied warranty of
+* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+* General Public License for more details.
+*
+* You should have received a copy of the GNU General Public License
+* along with this program; if not, write to the Free Software
+* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+* 02110-1301, USA.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "hashtab.h"
+
+hashtab_t *ht_init (size_t size, int (*hash_func) (void *, size_t, size_t))
+{
+	hashtab_t *new_ht = (hashtab_t *) malloc (sizeof (hashtab_t));
+
+	new_ht->arr = (hashtab_node_t **) malloc (sizeof (hashtab_node_t *) * size);
+
+	new_ht->size = size;
+	new_ht->count = 0;
+
+/* all entries are empty */
+	int i = 0;
+	for (i = 0; i < (int) size; i++)
+	{
+		new_ht->arr[i] = NULL;
+	}
+
+	if (hash_func == NULL)
+		new_ht->hash_func = &ht_hash;
+	else
+		new_ht->hash_func = hash_func;
+
+	return new_ht;
+}
+
+void *ht_get (hashtab_t * hashtable, void *key, size_t keylen)
+{
+	int index = ht_hash (key, keylen, hashtable->size);
+
+	if (hashtable->arr[index] == NULL) {
+		return NULL;
+	}
+
+	hashtab_node_t *last_node = hashtable->arr[index];
+	while (last_node != NULL)
+	{
+	/* only compare matching keylens */
+		if (last_node->keylen == keylen)
+		{
+	/* compare keys */
+			if (memcmp (key, last_node->key, keylen) == 0)
+			{
+				return last_node->value;
+			}
+		}
+
+		last_node = last_node->next;
+	}
+
+	return NULL;
+}
+
+void *ht_put (hashtab_t * hashtable,
+	void *key, size_t keylen, void *value, size_t vallen)
+{
+	int index = ht_hash (key, keylen, hashtable->size);
+
+	hashtab_node_t *next_node, *last_node;
+	next_node = hashtable->arr[index];
+	last_node = NULL;
+
+/* Search for an existing key. */
+	while (next_node != NULL)
+	{
+	/* only compare matching keylens */
+		if (next_node->keylen == keylen)
+		{
+	/* compare keys */
+			if (memcmp (key, next_node->key, keylen) == 0)
+			{
+		/* this key already exists, replace it */
+				if (next_node->vallen != vallen)
+				{
+		/* new value is a different size */
+					free (next_node->value);
+					next_node->value = malloc (vallen);
+					if (next_node->value == NULL)
+						return NULL;
+				}
+				memcpy (next_node->value, value, vallen);
+				next_node->vallen = vallen;
+				return next_node->value;
+			}
+		}
+
+		last_node = next_node;
+		next_node = next_node->next;
+	}
+
+/* create a new node */
+	hashtab_node_t *new_node;
+	new_node = (hashtab_node_t *) malloc (sizeof (hashtab_node_t));
+	if (new_node == NULL)
+		return NULL;
+
+/* get some memory for the new node data */
+	new_node->key = malloc (keylen);
+	new_node->value = malloc (vallen);
+	if (new_node->key == NULL || new_node->key == NULL)
+	{
+		free (new_node->key);
+		free (new_node->value);
+		free (new_node);
+		return NULL;
+	}
+
+/* copy over the value and key */
+	memcpy (new_node->key, key, keylen);
+	memcpy (new_node->value, value, vallen);
+	new_node->keylen = keylen;
+	new_node->vallen = vallen;
+
+/* no next node */
+	new_node->next = NULL;
+
+/* Tack the new node on the end or right on the table. */
+	if (last_node != NULL)
+		last_node->next = new_node;
+	else
+		hashtable->arr[index] = new_node;
+
+	hashtable->count++;
+	return new_node->value;
+}
+
+/* delete the given key from the hashtable */
+void ht_remove (hashtab_t * hashtable, void *key, size_t keylen)
+{
+	hashtab_node_t *last_node, *next_node;
+	int index = ht_hash (key, keylen, hashtable->size);
+	next_node = hashtable->arr[index];
+	last_node = NULL;
+
+	while (next_node != NULL)
+	{
+		if (next_node->keylen == keylen)
+		{
+	/* compare keys */
+			if (memcmp (key, next_node->key, keylen) == 0)
+			{
+		/* free node memory */
+				free (next_node->value);
+				free (next_node->key);
+
+		/* adjust the list pointers */
+				if (last_node != NULL)
+					last_node->next = next_node->next;
+				else
+					hashtable->arr[index] = next_node->next;
+
+		/* free the node */
+				free (next_node);
+				break;
+			}
+		}
+
+		last_node = next_node;
+		next_node = next_node->next;
+	}
+}
+
+/* grow the hashtable */
+void *ht_grow (hashtab_t * old_ht, size_t new_size)
+{
+/* create new hashtable */
+	hashtab_t *new_ht = ht_init (new_size, old_ht->hash_func);
+	if (new_ht == NULL)
+		return NULL;
+
+	void *ret;            /* captures return values */
+
+/* Iterate through the old hashtable. */
+	hashtab_iter_t ii;
+	ht_iter_init (old_ht, &ii);
+	for (; ii.key != NULL; ht_iter_inc (&ii))
+	{
+		ret = ht_put (new_ht, ii.key, ii.keylen, ii.value, ii.vallen);
+		if (ret == NULL)
+		{
+	/* Insert failed. Destroy new hashtable and return. */
+			ht_destroy (new_ht);
+			return NULL;
+		}
+	}
+
+/* Destroy the old hashtable. */
+	ht_destroy (old_ht);
+
+	return new_ht;
+}
+
+/* free all resources used by the hashtable */
+void ht_destroy (hashtab_t * hashtable)
+{
+	hashtab_node_t *next_node, *last_node;
+
+/* Free each linked list in hashtable. */
+	int i;
+	for (i = 0; i < (int) hashtable->size; i++)
+	{
+		next_node = hashtable->arr[i];
+		while (next_node != NULL)
+		{
+	/* destroy node */
+			free (next_node->key);
+			free (next_node->value);
+			last_node = next_node;
+			next_node = next_node->next;
+			free (last_node);
+		}
+	}
+
+	free (hashtable->arr);
+	free (hashtable);
+}
+
+/* iterator initilaize */
+void ht_iter_init (hashtab_t * hashtable, hashtab_iter_t * ii)
+{
+/* stick in initial bookeeping data */
+	ii->internal.hashtable = hashtable;
+	ii->internal.node = NULL;
+	ii->internal.index = -1;
+
+/* have iterator point to first element */
+	ht_iter_inc (ii);
+}
+
+/* iterator increment  */
+void ht_iter_inc (hashtab_iter_t * ii)
+{
+	hashtab_t *hashtable = ii->internal.hashtable;
+	int index = ii->internal.index;
+
+/* attempt to grab the next node */
+	if (ii->internal.node == NULL || ii->internal.node->next == NULL)
+		index++;
+	else
+	{
+	/* next node in the list */
+		ii->internal.node = ii->internal.node->next;
+		ii->key = ii->internal.node->key;
+		ii->value = ii->internal.node->value;
+		ii->keylen = ii->internal.node->keylen;
+		ii->vallen = ii->internal.node->vallen;
+		return;
+	}
+
+/* find next node */
+	while (hashtable->arr[index] == NULL && index < (int) hashtable->size)
+		index++;
+
+	if (index >= (int) hashtable->size)
+	{
+	/* end of hashtable */
+		ii->internal.node = NULL;
+		ii->internal.index = (int) hashtable->size;
+
+		ii->key = NULL;
+		ii->value = NULL;
+		ii->keylen = 0;
+		ii->vallen = 0;
+		return;
+	}
+
+/* point to the next item in the hashtable */
+	ii->internal.node = hashtable->arr[index];
+	ii->internal.index = index;
+	ii->key = ii->internal.node->key;
+	ii->value = ii->internal.node->value;
+	ii->keylen = ii->internal.node->keylen;
+	ii->vallen = ii->internal.node->vallen;
+}
+
+int ht_hash (void *key, size_t keylen, size_t hashtab_size)
+{
+	int sum = 0;
+
+/* very simple hash function for now */
+	int i;
+	for (i = 0; i < (int) keylen; i++)
+	{
+		sum += ((unsigned char *) key)[i] * (i + 1);
+	}
+
+	return (sum % (int) hashtab_size);
+}

hashtab.h

@@ -0,0 +1,120 @@
+/* hashtab.h - Simple, Reliable C Hashtable
+ * Copyright (C) 2007 Christopher Wellons <mosquitopsu@gmail.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301, USA.
+ */
+
+/* I needed a hashtable for a project and wanted to code my own. This
+ * hashtable compromises speed for reliability, specifically with
+ * growing the hashtable.
+ *
+ * The hashtable does not grow automatically, but when the hashtable
+ * grow function is called. Growing the hashtable is a safe operation:
+ * if growing the hashtable fails, the existing hashtable is not
+ * destroyed or modified.
+ *
+ * This hashtable is not thread-safe.
+ */
+
+#ifndef HASHTAB_H
+#define HASHTAB_H
+
+#include <stdlib.h>
+#include <string.h>
+
+typedef struct hashtab_node_t
+{
+  void *key;			/* key for the node */
+  size_t keylen;		/* length of the key */
+  void *value;			/* value for this node */
+  size_t vallen;		/* length of the value */
+
+  struct hashtab_node_t *next;	/* next node (open hashtable) */
+} hashtab_node_t;
+
+typedef struct hashtab_t
+{
+  hashtab_node_t **arr;
+  size_t size;			/* size of the hash */
+  int count;			/* number if items in this table */
+  int (*hash_func) (void *, size_t, size_t);	/* hash function */
+} hashtab_t;
+
+/* Iterator type for iterating through the hashtable. */
+typedef struct hashtab_iter_t
+{
+  /* key and value of current item */
+  void *key;
+  void *value;
+  size_t keylen;
+  size_t vallen;
+
+  /* bookkeeping data */
+  struct hashtab_internal_t
+  {
+    hashtab_t *hashtable;
+    hashtab_node_t *node;
+    int index;
+  } internal;
+
+} hashtab_iter_t;
+
+/* Initialize a new hashtable (set bookingkeeping data) and return a
+ * pointer to the hashtable. A hash function may be provided. If no
+ * function pointer is given (a NULL pointer), then the built in hash
+ * function is used. A NULL pointer returned if the creation of the
+ * hashtable failed due to a failed malloc(). */
+hashtab_t *ht_init (size_t size,
+		    int (*hash_func)
+		    (void *key, size_t keylen, size_t ht_size));
+
+/* Fetch a value from table matching the key. Returns a pointer to
+ * the value matching the given key. */
+void *ht_get (hashtab_t * hashtable, void *key, size_t keylen);
+
+/* Put a value into the table with the given key. Returns NULL if
+ * malloc() fails to allocate memory for the new node. */
+void *ht_put (hashtab_t * hashtable,
+		 void *key, size_t keylen, void *value, size_t vallen);
+
+/* Delete the given key and value pair from the hashtable. If the key
+ * does not exist, no error is given. */
+void ht_remove (hashtab_t * hashtable, void *key, size_t keylen);
+
+/* Change the size of the hashtable. It will allocate a new hashtable
+ * and move all keys and values over. The pointer to the new hashtable
+ * is returned. Will return NULL if the new hashtable fails to be
+ * allocated. If this happens, the old hashtable will not be altered
+ * in any way. The old hashtable is destroyed upon a successful
+ * grow. */
+void *ht_grow (hashtab_t * hashtable, size_t new_size);
+
+/* Free all resources used by the hashtable. */
+void ht_destroy (hashtab_t * hashtable);
+
+/* Initialize the given iterator. It will point to the first element
+ * in the hashtable. */
+void ht_iter_init (hashtab_t * hashtable, hashtab_iter_t * ii);
+
+/* Increment the iterator to the next element. The iterator key and
+ * value will point to NULL values when the iterator has reached the
+ * end of the hashtable.  */
+void ht_iter_inc (hashtab_iter_t * ii);
+
+/* Default hashtable hash function. */
+int ht_hash (void *key, size_t key_size, size_t hashtab_size);
+
+#endif

int.c

@@ -0,0 +1,60 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include "bool.h"
+#include "int.h"
+
+static LakeInt *int_alloc(void)
+{
+    LakeInt *i = malloc(sizeof(LakeInt));
+    i->base.type = TYPE_INT;
+    i->base.size = sizeof(LakeInt);
+    return i;
+}
+
+LakeInt *int_make(void)
+{
+    LakeInt *i = int_alloc();
+    i->val = 0;
+    return i;
+}
+
+LakeInt *int_copy(LakeInt *i)
+{
+    LakeInt *copy = int_alloc();
+    copy->val = i->val;
+    return copy;
+}
+
+LakeInt *int_from_c(int n)
+{
+    LakeInt *i = int_alloc();
+    i->val = n;
+    return i;
+}
+
+int int_val(LakeInt *i)
+{
+    return i->val;
+}
+
+LakeInt *int_cmp(LakeInt *a, LakeInt *b)
+{
+    int aN = a->val, bN = b->val;
+    LakeInt *result = int_alloc();
+    result->val = aN < bN ? -1 : (aN == bN ? 0 : 1);
+    return result;
+}
+
+LakeSym *int_eq(LakeInt *a, LakeInt *b)
+{
+    return bool_from_int(a->val == b->val);
+}
+
+LakeStr *int_to_str(LakeInt *i)
+{
+    static int size = 32;
+    char s[size];
+    snprintf(s, size, "%d", i->val);
+    LakeStr *str = str_from_c(s);
+    return str;
+}

int.h

@@ -0,0 +1,14 @@
+#ifndef _INT_H
+#define _INT_H 1
+
+#include "lake.h"
+
+LakeInt *int_make(void);
+LakeInt *int_copy(LakeInt *i);
+LakeInt *int_from_c(int n);
+int int_val(LakeInt *i);
+LakeInt *int_cmp(LakeInt *a, LakeInt *b);
+LakeSym *int_eq(LakeInt *a, LakeInt *b);
+LakeStr *int_to_str(LakeInt *i);
+
+#endif

lake.c

@@ -0,0 +1,167 @@
+/** 
+  * lake.c
+  * Lake Scheme
+  *
+  * Copyright 2011 Sami Samhuri
+  * MIT License
+  *
+  * A quick and dirty scheme written in C for fun and to use while
+  * reading The Little Schemer.
+  *
+  */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "env.h"
+#include "lake.h"
+#include "parse.h"
+
+static LakeVal _NIL = { TYPE_NIL, sizeof(LakeVal) };
+LakeVal *NIL = &_NIL;
+
+void die(char *msg)
+{
+    printf("error: %s\n", msg);
+    exit(1);
+}
+
+void oom(void)
+{
+    die("out of memory");
+}
+
+Env *primitive_bindings(void)
+{
+    Env *env = shared_env();
+    /* TODO */
+    return env;
+}
+
+void print(LakeVal *val)
+{
+    puts(repr(val));
+}
+
+LakeVal *prompt_read(char *prompt)
+{
+    static int n = 1024;
+    printf("%s", prompt);
+    char buf[n];
+    if (!fgets(buf, n, stdin)) {
+        if (ferror(stdin)) {
+            printf("error: cannot read from stdin");
+        }
+        return NULL;
+    }
+    return parse_expr(buf, strlen(buf));
+}
+
+void run_repl_with_env(Env *env)
+{
+    puts("Lake Scheme v" LAKE_VERSION);
+    LakeVal *expr;
+    LakeVal *result;
+    for (;;) {
+        expr = prompt_read("> ");
+        if (!expr) return;
+        result = env_eval(env, expr);
+        print(result);
+    }
+}
+
+void run_repl(void)
+{
+    run_repl_with_env(primitive_bindings());
+}
+
+void run_one_then_repl(int argc, char const *args[])
+{
+    /* create a top level environment */
+    Env *env = primitive_bindings();
+
+    /* bind args */
+    /*
+    LakeList *lakeArgs = list_of_strings_from_array(argc, args);
+    env_bind(env, "args", lakeArgs);
+    */
+
+    /* eval (load args[0]) in env */
+    
+    run_repl_with_env(env);
+}
+
+static char *list_repr(LakeList *list)
+{
+	char s[1024];
+	size_t n = 0;
+	s[n++] = '(';
+    int i;
+	char *s2;
+	size_t len;
+    for (i = 0; i < LIST_N(list); ++i) {
+		s2 = repr(LIST_VAL(list, i));
+		len = strlen(s2);
+        memcpy(s + n, s2, len);
+		n += len;
+		free(s2);
+        if (i != LIST_N(list) - 1) s[n++] = ' ';
+    }
+    s[n++] = ')';
+	s[n] = 0;
+	return strdup(s);
+}
+
+char *repr(LakeVal *expr)
+{
+    char *s = NULL;
+    LakeStr *str;
+    
+    switch (expr->type) {
+
+    case TYPE_NIL:
+        s = strdup("nil");
+        break;
+
+    case TYPE_SYM:
+        s = sym_repr(SYM(expr));
+        break;
+
+    case TYPE_BOOL:
+        printf("%s:%d TODO: repr for bools", __FILE__, __LINE__);
+        s = strdup("[bool]");
+        break;
+
+    case TYPE_INT:
+        str = int_to_str(INT(expr));
+        s = str_val(str);
+        str_free(str);
+        break;
+
+    case TYPE_STR:
+        str = STR(expr);
+        s = malloc(STR_N(str) + 3);
+        sprintf(s, "\"%s\"", STR_S(str));
+        break;
+
+    case TYPE_LIST:
+		s = list_repr(LIST(expr));
+        break;
+        
+    default:
+        printf("unrecognized value, type %d, size %lu bytes", expr->type, expr->size);
+        s = strdup("unrecognized value");
+    }
+    
+    return s;
+}
+
+int main (int argc, char const *argv[])
+{
+    if (argc == 1) {
+        run_repl();
+    } else {
+        run_one_then_repl(argc, argv);
+    }
+    return 0;
+}

lake.h

@@ -0,0 +1,81 @@
+#ifndef _LAKE_H
+#define _LAKE_H 1
+
+#include <stdlib.h>
+
+#define LAKE_VERSION "0.1"
+
+typedef int LakeType;
+
+#define TYPE_NIL  0
+#define TYPE_SYM  1
+#define TYPE_BOOL 2
+#define TYPE_INT  3
+#define TYPE_STR  4
+#define TYPE_LIST 5
+
+#define VAL(x) ((LakeVal *)x)
+#define SYM(x) ((LakeSym *)x)
+#define BOOL(x) ((LakeBool *)x)
+#define INT(x) ((LakeInt *)x)
+#define STR(x) ((LakeStr *)x)
+#define LIST(x) ((LakeList *)x)
+
+struct lake_val {
+    LakeType type;
+    size_t size;
+};
+typedef struct lake_val LakeVal;
+
+LakeVal *NIL;
+typedef LakeVal *NILP;
+
+#define VAL_SIZE(x) (x != NULL ? x->size : NIL->size)
+#define VAL_OR_NIL(x) (x != NULL ? (LakeVal *)x : NIL)
+
+struct lake_sym {
+    LakeVal base;
+    size_t n;
+    char *s;
+    unsigned long hash;
+};
+typedef struct lake_sym LakeSym;
+
+struct lake_int {
+    LakeVal base;
+    int val;
+};
+typedef struct lake_int LakeInt;
+
+struct lake_str {
+    LakeVal base;
+    size_t n;
+    char *s;
+};
+typedef struct lake_str LakeStr;
+
+#define STR_N(str) (str->n)
+#define STR_S(str) (str->s)
+
+struct lake_list {
+    LakeVal base;
+    size_t cap;
+    size_t n;
+    LakeVal **vals;
+};
+typedef struct lake_list LakeList;
+
+#define LIST_N(list) (list->n)
+#define LIST_VAL(list, i) (list->vals[i])
+
+void die(char *msg);
+void oom();
+char *repr(LakeVal *val);
+
+#include "sym.h"
+#include "bool.h"
+#include "int.h"
+#include "list.h"
+#include "string.h"
+
+#endif

list.c

@@ -0,0 +1,109 @@
+#include <stdlib.h>
+#include "int.h"
+#include "lake.h"
+#include "list.h"
+#include "string.h"
+
+#define LIST_INIT_CAP 2
+
+static LakeList *list_alloc(void)
+{
+    LakeList *list = malloc(sizeof(LakeList));
+    list->base.type = TYPE_LIST;
+    list->base.size = sizeof(LakeList);
+    return list;
+}
+
+LakeList *list_make(void)
+{
+    LakeList *list = list_make_with_cap(LIST_INIT_CAP);
+    int i;
+    for (i = 0; i < list->cap; ++i) {
+        list->vals[i] = NULL;
+    }
+    return list;
+}
+
+LakeList *list_make_with_cap(size_t cap)
+{
+    LakeList *list = list_alloc();
+    list->cap = cap;
+    list->n = 0;
+    list->vals = malloc(cap * sizeof(LakeVal *));
+    return list;
+}
+
+LakeList *list_from_array(size_t n, LakeVal *vals[])
+{
+    LakeList *list = list_make_with_cap(n);
+    int i;
+    for (i = 0; i < n; ++i) {
+        list->vals[i] = vals[i];
+    }
+    return list;
+}
+
+LakeInt *list_len(LakeList *list)
+{
+    return int_from_c(list->n);
+}
+
+NILP list_grow(LakeList *list)
+{
+    list->cap *= 2;
+    LakeVal **new_vals;
+    new_vals = malloc(list->cap * sizeof(LakeVal *));
+    int i;
+    for (i = 0; i < list->n; ++i) {
+        new_vals[i] = list->vals[i];
+    }
+    free(list->vals);
+    list->vals = new_vals;
+    return NIL;
+}
+
+NILP list_append(LakeList *list, LakeVal *val)
+{
+    if (list->n >= list->cap) {
+        list_grow(list);
+    }
+    list->vals[list->n++] = val;
+    return NIL;
+}
+
+NILP list_set(LakeList *list, size_t i, LakeVal *val)
+{
+    if (i < 0 || i >= list->n) {
+        /* TODO error */
+        return NULL;
+    }
+    list->vals[i] = val;
+    return NIL;
+}
+
+LakeVal *list_get(LakeList *list, LakeInt *li)
+{
+    int i = int_val(li);
+    if (i < 0 || i >= list->n) {
+        return NIL;
+    }
+    return VAL_OR_NIL(list->vals[i]);
+}
+
+LakeInt *list_cmp(LakeList *a, LakeList *b)
+{
+    /* TODO */
+    return 0;
+}
+
+LakeSym *list_eq(LakeList *a, LakeList *b)
+{
+    /* TODO */
+    return bool_from_int(a == b);
+}
+
+LakeStr *list_to_str(LakeList *list)
+{
+    /* TODO */
+    return str_from_c("[TODO]");
+}

list.h

@@ -0,0 +1,20 @@
+#ifndef _LIST_H
+#define _LIST_H 1
+
+#include <stdlib.h>
+#include "lake.h"
+#include "string.h"
+
+LakeList *list_make(void);
+LakeList *list_make_with_cap(size_t cap);
+LakeList *list_from_array(size_t n, LakeVal *vals[]);
+LakeInt *list_len(LakeList *list);
+NILP list_grow(LakeList *list);
+NILP list_append(LakeList *list, LakeVal *val);
+NILP list_set(LakeList *list, size_t i, LakeVal *val);
+LakeVal *list_get(LakeList *list, LakeInt *li);
+LakeInt *list_cmp(LakeList *a, LakeList *b);
+LakeSym *list_eq(LakeList *a, LakeList *b);
+LakeStr *list_to_str(LakeList *list);
+
+#endif

parse.c

@@ -0,0 +1,281 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "lake.h"
+#include "list.h"
+
+struct context {
+    char *s;
+    size_t n;
+    size_t i;
+};
+typedef struct context Ctx;
+
+static LakeVal *_parse_expr(Ctx *ctx);
+
+LakeVal *parse_expr(char *s, size_t n)
+{
+    Ctx ctx = { s, n, 0 };
+    LakeVal *result = _parse_expr(&ctx);
+    if (ctx.i < ctx.n) {
+        printf("ignoring %lu trailing chars: %s\n", ctx.n - ctx.i - 1, ctx.s + ctx.i);
+    }
+    return result;
+}
+
+#define PARSE_EOF -1
+
+static char peek(Ctx *ctx)
+{
+    if (ctx->i < ctx->n) return ctx->s[ctx->i];
+    return PARSE_EOF;
+}
+
+static char peek2(Ctx *ctx)
+{
+    if (ctx->i + 1 < ctx->n) return ctx->s[ctx->i + 1];
+    return PARSE_EOF;
+}
+
+static void consume(Ctx *ctx, size_t n)
+{
+    if (ctx->i + n > ctx->n) {
+        die("ERROR: cannot consume, no more input");
+    }
+    ctx->i += n;
+}
+
+static char consume1(Ctx *ctx)
+{
+    char c = peek(ctx);
+    consume(ctx, 1);
+    return c;
+}
+
+static char ch(Ctx *ctx, char expected)
+{
+    char c = peek(ctx);
+    if (c == expected) {
+        consume1(ctx);
+        return c;
+    }
+    char *msg = malloc(64);
+    sprintf(msg, "parse error, expected '%c' got '%c'", expected, c);
+    die(msg);
+    return 0; /* placate the compiler */
+}
+
+static int maybe_spaces(Ctx *ctx)
+{
+    char *p;
+    while ((p = strchr(" \r\n\t", peek(ctx))) != NULL) {
+        consume1(ctx);
+    }
+    return 1;
+}
+/*
+static int whitespace(Ctx *ctx)
+{
+    int result = 0;
+    char *p;
+    while ((p = strchr(" \r\n\t", peek(ctx))) != NULL) {
+        consume1(ctx);
+        result = 1;
+    }
+    return result;
+}
+*/
+static int is_letter(char c)
+{
+    return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z');
+}
+
+static int is_symbol(char c)
+{
+    return strchr("!$%&|*+-/:<=>?@^_~#", c) != NULL;
+}
+
+static int is_digit(char c)
+{
+    return c >= '0' && c <= '9';
+}
+
+static char *parse_while(Ctx *ctx, int (*is_valid)(char))
+{
+    size_t n = 8;
+    size_t i = 0;
+    char *s = malloc(n);
+    char c;
+    while ((c = peek(ctx)) != PARSE_EOF && is_valid(c)) {
+        s[i++] = c;
+        consume1(ctx);
+        /* grow if necessary */
+        if (i >= n) {
+            n *= 2;
+            char *t = realloc(s, n);
+            if (!t) oom();
+            s = t;
+        }
+    }
+    s[i] = 0;
+    return s;
+}
+
+static LakeInt *parse_int(Ctx *ctx)
+{
+    int n = 0;
+    char c = peek(ctx);
+    char sign = c == '-' ? -1 : 1;
+    if (c == '-' || c == '+') {
+        consume1(ctx);
+    }
+    while (is_digit(c = peek(ctx))) {
+        n *= 10;
+        n += c - '0';
+        consume1(ctx);
+    }
+    return int_from_c(sign * n);
+}
+
+static int is_sym_char(char c)
+{
+    return is_letter(c) || is_symbol(c) || is_digit(c);
+}
+
+static LakeSym *parse_sym(Ctx *ctx)
+{
+    static int size = 1024;
+    char s[size];
+    char c;
+    int i = 0;
+    while (is_sym_char(c = peek(ctx)) && i < size - 1) {
+        s[i++] = c;
+        consume1(ctx);
+    }
+    s[i] = 0;
+    /* TODO: check for #t and #f and return true boolean values (LakeBool *) */
+    return sym_intern(s);
+}
+
+static char escape_char(char c)
+{
+    switch (c) {
+
+    case 'n':
+        c = '\n';
+        break;
+
+    case 'r':
+        c = '\r';
+        break;
+        
+    case 't':
+        c = '\t';
+        break;
+
+    default:
+        /* noop */
+        break;
+        
+    }
+    return c;
+}
+
+static LakeStr *parse_str(Ctx *ctx)
+{
+    size_t n = 8;
+    size_t i = 0;
+    char *s = malloc(n);
+    char c;
+    ch(ctx, '"');
+    while ((c = peek(ctx)) != PARSE_EOF && c != '"') {
+        /* handle backslash escapes */
+        if (c == '\\') {
+            consume1(ctx);
+            c = escape_char(peek(ctx));
+            if (c == PARSE_EOF) break;
+        }
+        s[i++] = c;
+        consume1(ctx);
+        /* grow if necessary */
+        if (i >= n) {
+            n *= 2;
+            char *t = realloc(s, n);
+            if (!t) oom();
+            s = t;
+        }
+    }
+    s[i] = 0;
+    ch(ctx, '"');
+    LakeStr *str = str_from_c(s);
+    free(s);
+    return str;
+}
+
+static LakeList* parse_list(Ctx *ctx)
+{
+    LakeList *list = list_make();
+    ch(ctx, '(');
+    char c;
+    while ((c = peek(ctx)) != ')') {
+        if (c == PARSE_EOF) {
+            printf("error: end of input while parsing list");
+            return NIL;
+        }
+        list_append(list, _parse_expr(ctx));
+    }
+    ch(ctx, ')');
+    return list;
+}
+
+static int is_not_newline(char c)
+{
+    return !(c == '\n' || c == '\r');
+}
+
+static void parse_comment(Ctx *ctx)
+{
+    free(parse_while(ctx, is_not_newline));
+}
+
+static LakeVal *_parse_expr(Ctx *ctx)
+{
+    LakeVal *result = NIL;
+    char c = peek(ctx);
+    /*char d =*/ peek2(ctx);
+    if (c >= '0' && c <= '9') {
+        result = (LakeVal *)parse_int(ctx);
+    }
+    /* TODO: chars
+    else if (c == '#' && d == '\\') {
+        result = (LakeVal *)parse_char(ctx);
+    }
+    */
+    else if (is_letter(c) || is_symbol(c)) {
+        result = (LakeVal *)parse_sym(ctx);
+    }
+    else if (c == '"') {
+        result = (LakeVal *)parse_str(ctx);
+    }
+    /* TODO: quote
+    else if (c == '\'') {
+        result = (LakeVal *)parse_quoted(ctx);
+    }
+    */
+    else if (c == '(') {
+        result = (LakeVal *)parse_list(ctx);
+    }
+    else if (c == ';') {
+        parse_comment(ctx);
+    }
+    else if (c == PARSE_EOF) {
+        printf("error: end of input, expected an expression");
+    }
+    else {
+        char msg[32];
+        sprintf(msg, "unexpected char '%c'", c);
+        die(msg);
+    }
+    maybe_spaces(ctx);
+    return result;
+}

parse.h

@@ -0,0 +1,9 @@
+#ifndef _PARSE_H
+#define _PARSE_H 1
+
+#include <stdlib.h>
+#include "lake.h"
+
+LakeVal *parse_expr(char *s, size_t n);
+
+#endif

string.c

@@ -0,0 +1,70 @@
+#include <stdlib.h>
+#include <string.h>
+#include "int.h"
+#include "lake.h"
+#include "string.h"
+
+static LakeStr *str_alloc(void)
+{
+    LakeStr *str = malloc(sizeof(LakeStr));
+    str->base.type = TYPE_STR;
+    str->base.size = sizeof(LakeStr);
+    return str;
+}
+
+void str_free(LakeStr *str)
+{
+    free(str->s);
+    free(str);
+}
+
+LakeStr *str_make(void)
+{
+    return str_from_c("");
+}
+
+LakeInt *str_len(LakeStr *str)
+{
+    return int_from_c(str->n);
+}
+
+LakeStr *str_copy(LakeStr *str)
+{
+    return str_from_c(str->s);
+}
+
+LakeStr *str_from_c(char *s)
+{
+    LakeStr *str = str_alloc();
+    str_set(str, s);
+    return str;
+}
+
+char *str_val(LakeStr *str)
+{
+    return strdup(str->s);
+}
+
+NILP str_set(LakeStr *str, char *s)
+{
+    str->n = strlen(s);
+    str->s = strdup(s);
+    return NIL;
+}
+
+#define MIN(a, b) (a < b ? a : b)
+
+LakeInt *str_cmp(LakeStr *a, LakeStr *b)
+{
+    return int_from_c(strncmp(a->s, b->s, MIN(a->n, b->n)));
+}
+
+LakeSym *str_eq(LakeStr *a, LakeStr *b)
+{
+    return bool_from_int(strncmp(a->s, b->s, MIN(a->n, b->n)) == 0);
+}
+
+LakeStr *str_to_str(LakeStr *str)
+{
+    return str_copy(str);
+}

string.h

@@ -0,0 +1,17 @@
+#ifndef _STRING_H
+#define _STRING_H 1
+
+#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);
+NILP str_set(LakeStr *str, char *s);
+LakeInt *str_cmp(LakeStr *a, LakeStr *b);
+LakeSym *str_eq(LakeStr *a, LakeStr *b);
+LakeStr *str_to_str(LakeStr *str);
+
+#endif

sym.c

@@ -0,0 +1,60 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "env.h"
+#include "lake.h"
+#include "hashtab.h"
+#include "string.h"
+#include "sym.h"
+
+#define SYM_TABLE_SIZE 1024
+
+static LakeSym *sym_alloc(void)
+{
+    LakeSym *sym = malloc(sizeof(LakeSym));
+    sym->base.type = TYPE_SYM;
+    sym->base.size = sizeof(LakeSym);
+    return sym;
+}
+
+LakeSym *sym_intern(char *s)
+{
+    size_t n = strlen(s);
+    hashtab_t *symbols = shared_env()->symbols;
+    LakeSym *sym = ht_get(symbols, s, n);
+    if (!sym) {
+        sym = sym_alloc();
+        sym->n = n;
+        sym->s = strdup(s);
+        sym->hash = ht_hash(s, n, symbols->size);
+        ht_put(symbols, sym->s, sym->n, sym, sizeof(LakeSym));
+	}
+    return sym;
+}
+
+LakeStr *sym_to_str(LakeSym *sym)
+{
+    return str_from_c(sym->s);
+}
+
+LakeSym *sym_from_str(LakeStr *str)
+{
+    return sym_intern(str->s);
+}
+
+char *sym_repr(LakeSym *sym)
+{
+    return strdup(sym->s);
+}
+
+unsigned long sym_val(LakeSym *sym)
+{
+    return sym->hash;
+}
+
+#define MIN(a, b) (a < b ? a : b)
+
+LakeSym *sym_eq(LakeSym *a, LakeSym *b)
+{
+    return bool_from_int(strncmp(a->s, b->s, MIN(a->n, b->n)) == 0);
+}

sym.h

@@ -0,0 +1,13 @@
+#ifndef _SYM_H
+#define _SYM_H 1
+
+#include "lake.h"
+
+LakeSym *sym_intern(char *s);
+LakeStr *sym_to_str(LakeSym *sym);
+LakeSym *sym_from_str(LakeStr *str);
+char *sym_repr(LakeSym *sym);
+unsigned long sym_val(LakeSym *sym);
+LakeSym *sym_eq(LakeSym *a, LakeSym *b);
+
+#endif