c/step4_if_fn_do.c

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