usefull commit message

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;
+}