diff options
Diffstat (limited to 'src/main.c')
| -rw-r--r-- | src/main.c | 436 |
1 files changed, 436 insertions, 0 deletions
diff --git a/src/main.c b/src/main.c new file mode 100644 index 0000000..195e213 --- /dev/null +++ b/src/main.c @@ -0,0 +1,436 @@ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "lexer.h" +#include "value.h" +#include "env.h" + +#ifdef ENABLE_MEMDEBUG +#define MEMDEBUG_OUT_OF_BOUNDS +#define MEMDEBUG_IMPLEMENTATION +#define MEMDEBUG_MAIN_VOID +#define MEMDEBUG_OUTPUT_DIR "files" +#endif + +#include "common.h" +#include "builtin.h" + +#define LEN(arr) (sizeof(arr)/sizeof(*(arr))) + +// TODO: +// - Think about memory leakage and on non fatal errors +// like failed list creation and faild s-exp parsing +// - Check for functions not wrapped in ERR_* macro +// - Add more error messages + +#ifndef DEBUG +#define TOKEN_NEXT() \ + ERR_NZ(lexer_token_next(lexer, &token), r, \ + die("Can't get next token")) +#else +#define TOKEN_NEXT() do { \ + ERR_NZ(lexer_token_next(lexer, &token), r, \ + die("Can't get next token")); \ + print_token(&token); \ + } while(0); +#endif + +#define TOKEN_SKIP(ttype, fail) do { \ + if(token.type == ttype) { \ + TOKEN_NEXT(); \ + break; \ + } \ + err("Expected token '%s', not '%s'", \ + token_type_string[ttype], \ + token_type_string[token.type]); \ + fail; \ + } while(0) + +#define TOKEN_MATCH(ttype, fail) do { \ + TOKEN_NEXT(); \ + if(token.type == ttype) break; \ + \ + err("Expected token '%s', not '%s'", \ + token_type_string[ttype], \ + token_type_string[token.type]); \ + fail; \ + } while(0) + +#define HAS_ENOUGH_ARGS(proc, type, argc, fail) \ + if(argc != proc->value.type.argc) { \ + err("Wrong number of arguemnts, expected %zu, but got %zu", \ + proc->value.type.argc, argc); \ + fail; \ + } + +#define NOT_IMPLEMENTED() die("Not Implemented. ABORTING") + +static void print_token(struct token *token) +{ + char buf[256] = {0}; + ERR_Z(token_value_string(token, LEN(buf), buf), return); + info("%-12s %s", token_type_string[token->type], buf); +} + +static void print_value(value_t value) +{ + char buf[256] = {0}; + value_string(value, LEN(buf), buf); + info("%-12s %s", value ? + value_type_string[value->type] : "VALUE", buf); +} + +static lexer_t lexer = LEXER_EMPTY; +static env_t user_env = ENV_EMPTY; + +env_t env = ENV_EMPTY; +struct token token; + +value_t apply(value_t proc, size_t argc, value_t *argv); +value_t evaluate(void); +value_t evaluate_sexp(void); +value_t evaluate_id(void); +value_t evaluate_lambda(void); +value_t evaluate_define(void); +value_t evaluate_quote(void); +value_t quote_sexp(void); + +static void destroy_env(char *key, value_t value) +{ + (void)key; + value_destroy(value); +} + +static void destroy_user_env(char *key, value_t value) +{ + free(key); + value_destroy(value); +} + +int main(void) +{ + user_env = env_create(ENV_EMPTY, destroy_user_env); + env = env_create(user_env, destroy_env); + + for(size_t i = 0; i < BUILTIN_PROCEDURES; i++) { + value_t proc_value = value_create( + VALUE_PROC_BUILTIN, + (void *)&builtin_proc_descriptions[i]); + hashtable_insert(env->table, + (void *)builtin_proc_name_list[i], + (void *)proc_value, NULL, NULL); + } + char *filename = "files/test.l"; + + FILE *fp = fopen(filename, "r"); + if(!fp) { + die("fopen: %s", strerror(errno)); + } + + lexer = lexer_create(fp); + + while(lexer_token_next(lexer, &token) == 0) { + value_t val = evaluate(); + + #ifdef FDEBUG + print_value(); + #else + char buf[256] = {0}; + value_string(val, LEN(buf), buf); + printf("%s:%zu: %s\n", filename, lexer->line, buf); + #endif + + value_destroy(val); + } + + lexer_destroy(lexer); + fclose(fp); + + env_destroy(env); + env_destroy(user_env); + return 0; +} + +value_t apply(value_t proc, size_t argc, value_t *argv) +{ + // TODO: make a global nil and copy it + if(proc == VALUE_EMPTY) return value_create(VALUE_NIL, NULL); + + switch(proc->type) { + case VALUE_PROC: + HAS_ENOUGH_ARGS(proc, proc, argc, return VALUE_EMPTY); + NOT_IMPLEMENTED(); + return VALUE_EMPTY; + case VALUE_PROC_BUILTIN: + HAS_ENOUGH_ARGS(proc, proc_builtin, argc, return VALUE_EMPTY); + return proc->value.proc_builtin.proc(argv); + default: + err("Value is not a procedure"); + return VALUE_EMPTY; + } +} + +#define IS_NOT_FIRST(arg, fail) \ + if(arg != 0) { \ + err("special forms can only be the first argument"); \ + fail; \ + } +#define SPECIAL_FORM(ret, argc, fn, fail) do { \ + IS_NOT_FIRST(argc, fail); \ + ERR_Z(ret = fn, fail); \ + TOKEN_MATCH(TOKEN_RP, \ + ret = VALUE_EMPTY; \ + fail); \ + } while(0) + +value_t evaluate(void) +{ + value_t ret = VALUE_EMPTY; + + switch(token.type) { + case TOKEN_LP: + ERR_Z(ret = evaluate_sexp(), goto exit); + break; + case TOKEN_ID: + ERR_Z(ret = evaluate_id(), goto exit); + break; + case TOKEN_STR: + case TOKEN_INT: + ERR_Z(ret = value_from_token(&token), goto exit); + break; + case TOKEN_QUOTE: + TOKEN_NEXT(); + ERR_Z(ret = evaluate_quote(), goto exit); + break; + default: + err("Did not exptect token '%s'", token_type_string[token.type]); + break; + } + +exit: + return ret; +} + +value_t evaluate_sexp(void) +{ + value_t ret = VALUE_EMPTY; + value_t body[256] = {VALUE_EMPTY}; + size_t argc = 0; + + TOKEN_SKIP(TOKEN_LP, goto exit); + + for(argc = 0; token.type != TOKEN_RP; argc++) + { + if(argc >= LEN(body)) { + err("Too many arguments"); + goto exit; + } + + switch(token.type) { + case TOKEN_LAMBDA: + SPECIAL_FORM(ret, argc, evaluate_lambda(), goto exit); + goto exit; + case TOKEN_DEFINE: + SPECIAL_FORM(ret, argc, evaluate_define(), goto exit); + goto exit; + case TOKEN_QUOTE_FORM: + TOKEN_NEXT(); + SPECIAL_FORM(ret, argc, evaluate_quote(), goto exit); + goto exit; + default: + ERR_Z(body[argc] = evaluate(), goto exit); + break; + } + + TOKEN_NEXT(); + } + + ret = apply(body[0], argc-1, &body[1]); + + #ifdef DEBUG + info("------------------"); + info("Applying procedure"); + print_value(body[0]); + info("With Arguemnts"); + if(argc > 0) + for(size_t i = 0; i < argc-1; i++) print_value(body[i+1]); + info("Returns"); + print_value(ret); + info("-----------------"); + #endif + +exit: + for(size_t i = 0; i < argc; i++) + value_destroy(body[i]); + return ret; +} + +static value_t evaluate_id_env(env_t env) +{ + if(env == ENV_EMPTY) return VALUE_EMPTY; + + value_t ret = VALUE_EMPTY; + ERR_NZ(hashtable_query(env->table, (void *)token.value.id, (void **)&ret), _r, return evaluate_id_env(env->parent)); + + return value_copy(ret); +} + +value_t evaluate_id(void) +{ + return evaluate_id_env(env); +} + +value_t evaluate_lambda(void) +{ + NOT_IMPLEMENTED(); +} + +#define STR_ALLOC_COPY(dest, str) do { \ + size_t len = strlen(str) + 1; \ + dest = malloc(len); \ + memcpy((dest), (str), len); \ + } while(0) + +value_t evaluate_define(void) +{ + // TODO: don't alloc when the key is the same + + value_t ret = VALUE_EMPTY; + char *key = NULL; + + TOKEN_SKIP(TOKEN_DEFINE, goto exit); + + // only in the outside environement + if(env->parent != user_env) goto exit; + + switch(token.type) + { + case TOKEN_ID: + STR_ALLOC_COPY(key, token.value.id); + break; + default: + err("Did not exptect token '%s'", token_type_string[token.type]); + goto exit; + } + + TOKEN_NEXT(); + ERR_Z(ret = evaluate(), goto exit); + + TOKEN_MATCH(TOKEN_RP, goto exit); + + value_t prevval = VALUE_EMPTY; + char *prevkey = NULL; + + ERR_NZ( + hashtable_insert(user_env->table, (void *)key, (void *)ret, + (void**)&prevkey, (void **)&prevval), + r, { + err("Couldn't insert symbol into the hashtable due to %s", strerror(r)); + value_destroy(ret); + free(key); + return VALUE_EMPTY; + }); + + if(prevkey) free(prevkey); + value_destroy(prevval); +exit: + return VALUE_EMPTY; +} + +value_t evaluate_quote(void) +{ + value_t ret = VALUE_EMPTY; + + switch(token.type) { + case TOKEN_ID: + case TOKEN_STR: + case TOKEN_INT: + ERR_Z(ret = value_from_token(&token), goto exit); + break; + case TOKEN_QUOTE: + case TOKEN_LAMBDA: + case TOKEN_DEFINE: + case TOKEN_QUOTE_FORM: ; + char name[64] = {0}; + ERR_Z(token_value_string(&token, LEN(name), name), goto exit); + struct token temp = {0}; temp.type = TOKEN_ID; temp.value.id = name; + ERR_Z(ret = value_from_token(&temp), goto exit); + break; + case TOKEN_LP: + ERR_Z(ret = quote_sexp(), goto exit); + break; + case TOKEN_UNQUOTE: + TOKEN_SKIP(TOKEN_UNQUOTE, goto exit); + ERR_Z(ret = evaluate(), goto exit); + break; + default: + err("Did not exptect token '%s'", token_type_string[token.type]); + break; + } +exit: + return ret; +} + +value_t quote_sexp(void) +{ + value_t ret = VALUE_EMPTY; + value_t left = VALUE_EMPTY; + value_t right = VALUE_EMPTY; + value_t nil = VALUE_EMPTY; + + // TODO: make global nil and copy it + ERR_Z(nil = value_create(VALUE_NIL, NULL), goto exit); + + TOKEN_SKIP(TOKEN_LP, goto exit); + + // Parse NIL + if(token.type == TOKEN_RP) { + ret = value_copy(nil); + goto exit; + } + + ERR_Z(left = evaluate_quote(), goto exit); + + TOKEN_NEXT(); + if(token.type == TOKEN_DOT) + { + // Parse cons + TOKEN_NEXT(); + ERR_Z(right = evaluate_quote(), return VALUE_EMPTY); + TOKEN_MATCH(TOKEN_RP, return VALUE_EMPTY); + + struct cons cons = {value_copy(left), value_copy(right)}; + ret = value_create(VALUE_CONS, &cons); + goto exit; + } + + // Parse list + right = value_copy(nil); + value_t *rightmost = &right; // the final nil + while(token.type != TOKEN_RP) + { + value_t new = VALUE_EMPTY; + ERR_Z(new = evaluate_quote(), + goto exit); + + value_t new_cons = VALUE_EMPTY; + struct cons cons = {new, *rightmost}; + ERR_Z(new_cons = value_create(VALUE_CONS, &cons), + value_destroy(new); + goto exit); + + *rightmost = new_cons; + rightmost = &new_cons->value.cons.right; + + TOKEN_NEXT(); + } + + struct cons cons = {value_copy(left), value_copy(right)}; + ret = value_create(VALUE_CONS, &cons); +exit: + value_destroy(left); + value_destroy(right); + value_destroy(nil); + return ret; +} |