commit 70fe7a1a58636bac079de8ca20daa31409d342ee Author: Sami Samhuri Date: Sun Apr 17 21:24:23 2011 -0700 first commit 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