From 70fe7a1a58636bac079de8ca20daa31409d342ee Mon Sep 17 00:00:00 2001 From: Sami Samhuri Date: Sun, 17 Apr 2011 21:24:23 -0700 Subject: [PATCH] first commit --- .gitignore | 2 + Makefile | 8 ++ bool.c | 28 +++++ bool.h | 12 +++ env.c | 107 ++++++++++++++++++ env.h | 25 +++++ hashtab.c | 310 +++++++++++++++++++++++++++++++++++++++++++++++++++++ hashtab.h | 120 +++++++++++++++++++++ int.c | 60 +++++++++++ int.h | 14 +++ lake.c | 167 +++++++++++++++++++++++++++++ lake.h | 81 ++++++++++++++ list.c | 109 +++++++++++++++++++ list.h | 20 ++++ parse.c | 281 ++++++++++++++++++++++++++++++++++++++++++++++++ parse.h | 9 ++ string.c | 70 ++++++++++++ string.h | 17 +++ sym.c | 60 +++++++++++ sym.h | 13 +++ 20 files changed, 1513 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 bool.c create mode 100644 bool.h create mode 100644 env.c create mode 100644 env.h create mode 100644 hashtab.c create mode 100644 hashtab.h create mode 100644 int.c create mode 100644 int.h create mode 100644 lake.c create mode 100644 lake.h create mode 100644 list.c create mode 100644 list.h create mode 100644 parse.c create mode 100644 parse.h create mode 100644 string.c create mode 100644 string.h create mode 100644 sym.c create mode 100644 sym.h diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2ca1d33 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.o +lake diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..9d8e247 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/bool.c b/bool.c new file mode 100644 index 0000000..fcbdba2 --- /dev/null +++ b/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 */ +} diff --git a/bool.h b/bool.h new file mode 100644 index 0000000..6ed9cf2 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/env.c b/env.c new file mode 100644 index 0000000..f78e3f3 --- /dev/null +++ b/env.c @@ -0,0 +1,107 @@ +#include +#include +#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; +} \ No newline at end of file diff --git a/env.h b/env.h new file mode 100644 index 0000000..34bd0a1 --- /dev/null +++ b/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 diff --git a/hashtab.c b/hashtab.c new file mode 100644 index 0000000..532528b --- /dev/null +++ b/hashtab.c @@ -0,0 +1,310 @@ +/* hashtab.c - Simple, Reliable C Hashtable +* Copyright (C) 2007 Christopher Wellons +* +* 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 +#include +#include +#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); +} diff --git a/hashtab.h b/hashtab.h new file mode 100644 index 0000000..82eb08c --- /dev/null +++ b/hashtab.h @@ -0,0 +1,120 @@ +/* hashtab.h - Simple, Reliable C Hashtable + * Copyright (C) 2007 Christopher Wellons + * + * 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 +#include + +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 diff --git a/int.c b/int.c new file mode 100644 index 0000000..72cff0b --- /dev/null +++ b/int.c @@ -0,0 +1,60 @@ +#include +#include +#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; +} diff --git a/int.h b/int.h new file mode 100644 index 0000000..b43c5d9 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/lake.c b/lake.c new file mode 100644 index 0000000..7a2222d --- /dev/null +++ b/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 +#include +#include +#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; +} diff --git a/lake.h b/lake.h new file mode 100644 index 0000000..dc5c010 --- /dev/null +++ b/lake.h @@ -0,0 +1,81 @@ +#ifndef _LAKE_H +#define _LAKE_H 1 + +#include + +#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 \ No newline at end of file diff --git a/list.c b/list.c new file mode 100644 index 0000000..8fa419b --- /dev/null +++ b/list.c @@ -0,0 +1,109 @@ +#include +#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]"); +} diff --git a/list.h b/list.h new file mode 100644 index 0000000..c439076 --- /dev/null +++ b/list.h @@ -0,0 +1,20 @@ +#ifndef _LIST_H +#define _LIST_H 1 + +#include +#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 diff --git a/parse.c b/parse.c new file mode 100644 index 0000000..00191f9 --- /dev/null +++ b/parse.c @@ -0,0 +1,281 @@ +#include +#include +#include +#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; +} diff --git a/parse.h b/parse.h new file mode 100644 index 0000000..dc545cf --- /dev/null +++ b/parse.h @@ -0,0 +1,9 @@ +#ifndef _PARSE_H +#define _PARSE_H 1 + +#include +#include "lake.h" + +LakeVal *parse_expr(char *s, size_t n); + +#endif \ No newline at end of file diff --git a/string.c b/string.c new file mode 100644 index 0000000..c191791 --- /dev/null +++ b/string.c @@ -0,0 +1,70 @@ +#include +#include +#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); +} diff --git a/string.h b/string.h new file mode 100644 index 0000000..84a2fb9 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/sym.c b/sym.c new file mode 100644 index 0000000..1d72ea2 --- /dev/null +++ b/sym.c @@ -0,0 +1,60 @@ +#include +#include +#include +#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); +} diff --git a/sym.h b/sym.h new file mode 100644 index 0000000..4c48dc8 --- /dev/null +++ b/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 \ No newline at end of file