impls/c/step4_if_fn_do.c

   1 #include <stdlib.h>
   2 #include <stdio.h>
   3 #include <string.h>
   4 #include <unistd.h>
   5
   6 #include "types.h"
   7 #include "readline.h"
   8 #include "reader.h"
   9 #include "core.h"
  10
  11 // Declarations
  12 MalVal *EVAL(MalVal *ast, Env *env);
  13
  14 // read
  15 MalVal *READ(char prompt[], char *str) {
  16     char *line;
  17     MalVal *ast;
  18     if (str) {
  19         line = str;
  20     } else {
  21         line = _readline(prompt);
  22         if (!line) {
  23             _error("EOF");
  24             return NULL;
  25         }
  26     }
  27     ast = read_str(line);
  28     if (!str) { MAL_GC_FREE(line); }
  29     return ast;
  30 }
  31
  32 // eval
  33 MalVal *eval_ast(MalVal *ast, Env *env) {
  34     if (!ast || mal_error) return NULL;
  35     if (ast->type == MAL_SYMBOL) {
  36         //g_print("EVAL symbol: %s\n", ast->val.string);
  37         return env_get(env, ast);
  38     } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) {
  39         //g_print("EVAL sequential: %s\n", _pr_str(ast,1));
  40         MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env);
  41         if (!el || mal_error) return NULL;
  42         el->type = ast->type;
  43         return el;
  44     } else if (ast->type == MAL_HASH_MAP) {
  45         //g_print("EVAL hash_map: %s\n", _pr_str(ast,1));
  46         GHashTableIter iter;
  47         gpointer key, value;
  48         MalVal *seq = malval_new_list(MAL_LIST,
  49                                     g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
  50                                                         _count(ast)));
  51         g_hash_table_iter_init (&iter, ast->val.hash_table);
  52         while (g_hash_table_iter_next (&iter, &key, &value)) {
  53             MalVal *kname = malval_new_string((char *)key);
  54             g_array_append_val(seq->val.array, kname);
  55             MalVal *new_val = EVAL((MalVal *)value, env);
  56             g_array_append_val(seq->val.array, new_val);
  57         }
  58         return _hash_map(seq);
  59     } else {
  60         //g_print("EVAL scalar: %s\n", _pr_str(ast,1));
  61         return ast;
  62     }
  63 }
  64
  65 MalVal *EVAL(MalVal *ast, Env *env) {
  66     if (!ast || mal_error) return NULL;
  67     //g_print("EVAL: %s\n", _pr_str(ast,1));
  68     if (ast->type != MAL_LIST) {
  69         return eval_ast(ast, env);
  70     }
  71     if (!ast || mal_error) return NULL;
  72
  73     // apply list
  74     //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
  75     int i, len;
  76     if (_count(ast) == 0) { return ast; }
  77     MalVal *a0 = _nth(ast, 0);
  78     if ((a0->type & MAL_SYMBOL) &&
  79         strcmp("def!", a0->val.string) == 0) {
  80         //g_print("eval apply def!\n");
  81         MalVal *a1 = _nth(ast, 1),
  82                *a2 = _nth(ast, 2);
  83         MalVal *res = EVAL(a2, env);
  84         if (mal_error) return NULL;
  85         env_set(env, a1, res);
  86         return res;
  87     } else if ((a0->type & MAL_SYMBOL) &&
  88                strcmp("let*", a0->val.string) == 0) {
  89         //g_print("eval apply let*\n");
  90         MalVal *a1 = _nth(ast, 1),
  91                *a2 = _nth(ast, 2),
  92                *key, *val;
  93         assert_type(a1, MAL_LIST|MAL_VECTOR,
  94                     "let* bindings must be list or vector");
  95         len = _count(a1);
  96         assert((len % 2) == 0, "odd number of let* bindings forms");
  97         Env *let_env = new_env(env, NULL, NULL);
  98         for(i=0; i<len; i+=2) {
  99             key = g_array_index(a1->val.array, MalVal*, i);
 100             val = g_array_index(a1->val.array, MalVal*, i+1);
 101             assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
 102             env_set(let_env, key, EVAL(val, let_env));
 103         }
 104         return EVAL(a2, let_env);
 105     } else if ((a0->type & MAL_SYMBOL) &&
 106                strcmp("do", a0->val.string) == 0) {
 107         //g_print("eval apply do\n");
 108         MalVal *el = eval_ast(_rest(ast), env);
 109         return _last(el);
 110     } else if ((a0->type & MAL_SYMBOL) &&
 111                strcmp("if", a0->val.string) == 0) {
 112         //g_print("eval apply if\n");
 113         MalVal *a1 = _nth(ast, 1);
 114         MalVal *cond = EVAL(a1, env);
 115         if (!cond || mal_error) return NULL;
 116         if (cond->type & (MAL_FALSE|MAL_NIL)) {
 117             // eval false slot form
 118             if (ast->val.array->len > 3) {
 119                 return EVAL(_nth(ast, 3), env);
 120             } else {
 121                 return &mal_nil;
 122             }
 123         } else {
 124             // eval true slot form
 125             MalVal *a2 = _nth(ast, 2);
 126             return EVAL(a2, env);
 127         }
 128     } else if ((a0->type & MAL_SYMBOL) &&
 129                strcmp("fn*", a0->val.string) == 0) {
 130         //g_print("eval apply fn*\n");
 131         MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
 132         mf->val.func.evaluator = EVAL;
 133         mf->val.func.args = _nth(ast, 1);
 134         mf->val.func.body = _nth(ast, 2);
 135         mf->val.func.env = env;
 136         return mf;
 137     } else {
 138         //g_print("eval apply\n");
 139         MalVal *el = eval_ast(ast, env);
 140         if (!el || mal_error) { return NULL; }
 141         MalVal *f = _first(el),
 142                *args = _rest(el);
 143         assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
 144                     "cannot apply '%s'", _pr_str(f,1));
 145         return _apply(f, args);
 146     }
 147 }
 148
 149 // print
 150 char *PRINT(MalVal *exp) {
 151     if (mal_error) {
 152         return NULL;
 153     }
 154     return _pr_str(exp,1);
 155 }
 156
 157 // repl
 158
 159 // read and eval
 160 MalVal *RE(Env *env, char *prompt, char *str) {
 161     MalVal *ast, *exp;
 162     ast = READ(prompt, str);
 163     if (!ast || mal_error) return NULL;
 164     exp = EVAL(ast, env);
 165     if (ast != exp) {
 166         malval_free(ast);    // Free input structure
 167     }
 168     return exp;
 169 }
 170
 171 // Setup the initial REPL environment
 172 Env *repl_env;
 173
 174 void init_repl_env() {
 175     repl_env = new_env(NULL, NULL, NULL);
 176
 177     // core.c: defined using C
 178     int i;
 179     for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
 180         env_set(repl_env,
 181                 malval_new_symbol(core_ns[i].name),
 182                 malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
 183     }
 184
 185     // core.mal: defined using the language itself
 186     RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
 187 }
 188
 189 int main()
 190 {
 191     MalVal *exp;
 192     char *output;
 193     char prompt[100];
 194
 195     MAL_GC_SETUP();
 196
 197     // Set the initial prompt and environment
 198     snprintf(prompt, sizeof(prompt), "user> ");
 199     init_repl_env();
 200
 201     // repl loop
 202     for(;;) {
 203         exp = RE(repl_env, prompt, NULL);
 204         if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
 205             return 0;
 206         }
 207         output = PRINT(exp);
 208
 209         if (mal_error) {
 210             fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1));
 211             malval_free(mal_error);
 212             mal_error = NULL;
 213         } else if (output) {
 214             puts(output);
 215             MAL_GC_FREE(output);        // Free output string
 216         }
 217
 218         //malval_free(exp);    // Free evaluated expression
 219     }
 220 }