aboutsummaryrefslogtreecommitdiff
path: root/c
diff options
context:
space:
mode:
Diffstat (limited to 'c')
-rw-r--r--c/core.c96
-rw-r--r--c/core.h16
-rw-r--r--c/step1_read_print.c1
-rw-r--r--c/step2_eval.c14
-rw-r--r--c/step3_env.c13
-rw-r--r--c/step4_if_fn_do.c23
-rw-r--r--c/step5_tco.c177
-rw-r--r--c/step6_file.c249
-rw-r--r--c/step7_quote.c271
-rw-r--r--c/step8_macros.c311
-rw-r--r--c/step9_interop.c320
-rw-r--r--c/stepA_more.c368
-rw-r--r--c/types.c30
-rw-r--r--c/types.h16
14 files changed, 885 insertions, 1020 deletions
diff --git a/c/core.c b/c/core.c
index 33bb991..2c76a95 100644
--- a/c/core.c
+++ b/c/core.c
@@ -2,9 +2,12 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <sys/stat.h>
+#include <fcntl.h>
#include "types.h"
#include "core.h"
+#include "reader.h"
#include "printer.h"
// Errors/Exceptions
@@ -80,17 +83,49 @@ MalVal *println(MalVal *args) {
return &mal_nil;
}
+MalVal *mal_readline(MalVal *str) {
+ assert_type(str, MAL_STRING, "readline of non-string");
+ char * line = _readline(str->val.string);
+ if (line) { return malval_new_string(line); }
+ else { return &mal_nil; }
+}
-// Number functions
+MalVal *read_string(MalVal *str) {
+ assert_type(str, MAL_STRING, "read_string of non-string");
+ return read_str(str->val.string);
+}
-#define WRAP_INTEGER_OP(name, op) \
- MalVal *int_ ## name(MalVal *a, MalVal *b) { \
- return malval_new_integer(a->val.intnum op b->val.intnum); \
+char *slurp_raw(char *path) {
+ char *data;
+ struct stat fst;
+ int fd = open(path, O_RDONLY),
+ sz;
+ if (fd < 0) {
+ abort("slurp failed to open '%s'", path);
+ }
+ if (fstat(fd, &fst) < 0) {
+ abort("slurp failed to stat '%s'", path);
}
-#define WRAP_INTEGER_CMP_OP(name, op) \
- MalVal *int_ ## name(MalVal *a, MalVal *b) { \
- return a->val.intnum op b->val.intnum ? &mal_true : &mal_false; \
+ data = malloc(fst.st_size+1);
+ sz = read(fd, data, fst.st_size);
+ if (sz < fst.st_size) {
+ abort("slurp failed to read '%s'", path);
}
+ data[sz] = '\0';
+ return data;
+}
+MalVal *slurp(MalVal *path) {
+ assert_type(path, MAL_STRING, "slurp of non-string");
+ char *data = slurp_raw(path->val.string);
+ if (!data || mal_error) { return NULL; }
+ return malval_new_string(data);
+}
+
+
+
+
+// Number functions
+
WRAP_INTEGER_OP(plus,+)
WRAP_INTEGER_OP(minus,-)
WRAP_INTEGER_OP(multiply,*)
@@ -115,7 +150,6 @@ MalVal *vector_Q(MalVal *seq) { return _vector_Q(seq) ? &mal_true : &mal_false;
// Hash map functions
-MalVal *hash_map(MalVal *args) { return _hash_map(args); }
MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; }
MalVal *assoc(MalVal *args) {
@@ -123,15 +157,15 @@ MalVal *assoc(MalVal *args) {
"assoc called with non-sequential arguments");
assert(_count(args) >= 2,
"assoc needs at least 2 arguments");
- GHashTable *htable = g_hash_table_copy(first(args)->val.hash_table);
+ GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table);
MalVal *hm = malval_new_hash_map(htable);
- return _assoc_BANG(hm, rest(args));
+ return _assoc_BANG(hm, _rest(args));
}
MalVal *dissoc(MalVal* args) {
- GHashTable *htable = g_hash_table_copy(first(args)->val.hash_table);
+ GHashTable *htable = g_hash_table_copy(_first(args)->val.hash_table);
MalVal *hm = malval_new_hash_map(htable);
- return _dissoc_BANG(hm, rest(args));
+ return _dissoc_BANG(hm, _rest(args));
}
MalVal *keys(MalVal *obj) {
@@ -249,19 +283,6 @@ MalVal *nth(MalVal *seq, MalVal *idx) {
return _nth(seq, idx->val.intnum);
}
-MalVal *first(MalVal *seq) {
- assert_type(seq, MAL_LIST|MAL_VECTOR,
- "first called with non-sequential");
- if (_count(seq) == 0) {
- return &mal_nil;
- }
- return g_array_index(seq->val.array, MalVal*, 0);
-}
-
-MalVal *rest(MalVal *seq) {
- return _slice(seq, 1, _count(seq));
-}
-
MalVal *empty_Q(MalVal *seq) {
assert_type(seq, MAL_LIST|MAL_VECTOR,
"empty? called with non-sequential");
@@ -296,20 +317,11 @@ MalVal *sconj(MalVal *args) {
return malval_new_list(src_lst->type, new_arr);
}
-MalVal *last(MalVal *seq) {
- assert_type(seq, MAL_LIST|MAL_VECTOR,
- "last called with non-sequential");
- if (_count(seq) == 0) {
- return &mal_nil;
- }
- return g_array_index(seq->val.array, MalVal*, _count(seq)-1);
-}
-
MalVal *apply(MalVal *args) {
assert_type(args, MAL_LIST|MAL_VECTOR,
"apply called with non-sequential");
MalVal *f = _nth(args, 0);
- MalVal *last_arg = last(args);
+ MalVal *last_arg = _last(args);
assert_type(last_arg, MAL_LIST|MAL_VECTOR,
"last argument to apply is non-sequential");
int i, len = _count(args) - 2 + _count(last_arg);
@@ -410,7 +422,7 @@ MalVal *swap_BANG(MalVal *args) {
-core_ns_entry core_ns[50] = {
+core_ns_entry core_ns[53] = {
{"=", (void*(*)(void*))equal_Q, 2},
{"throw", (void*(*)(void*))throw, 1},
{"nil?", (void*(*)(void*))nil_Q, 1},
@@ -418,10 +430,14 @@ core_ns_entry core_ns[50] = {
{"false?", (void*(*)(void*))false_Q, 1},
{"symbol", (void*(*)(void*))symbol, 1},
{"symbol?", (void*(*)(void*))symbol_Q, 1},
+
{"pr-str", (void*(*)(void*))pr_str, -1},
{"str", (void*(*)(void*))str, -1},
{"prn", (void*(*)(void*))prn, -1},
{"println", (void*(*)(void*))println, -1},
+ {"readline", (void*(*)(void*))mal_readline, 1},
+ {"read-string", (void*(*)(void*))read_string, 1},
+ {"slurp", (void*(*)(void*))slurp, 1},
{"<", (void*(*)(void*))int_lt, 2},
{"<=", (void*(*)(void*))int_lte, 2},
{">", (void*(*)(void*))int_gt, 2},
@@ -435,7 +451,7 @@ core_ns_entry core_ns[50] = {
{"list?", (void*(*)(void*))list_Q, 1},
{"vector", (void*(*)(void*))vector, -1},
{"vector?", (void*(*)(void*))vector_Q, 1},
- {"hash-map", (void*(*)(void*))hash_map, -1},
+ {"hash-map", (void*(*)(void*))_hash_map, -1},
{"map?", (void*(*)(void*))hash_map_Q, 1},
{"assoc", (void*(*)(void*))assoc, -1},
{"dissoc", (void*(*)(void*))dissoc, -1},
@@ -448,9 +464,9 @@ core_ns_entry core_ns[50] = {
{"cons", (void*(*)(void*))cons, 2},
{"concat", (void*(*)(void*))concat, -1},
{"nth", (void*(*)(void*))nth, 2},
- {"first", (void*(*)(void*))first, 1},
- {"rest", (void*(*)(void*))rest, 1},
- {"last", (void*(*)(void*))last, 1},
+ {"first", (void*(*)(void*))_first, 1},
+ {"rest", (void*(*)(void*))_rest, 1},
+ {"last", (void*(*)(void*))_last, 1},
{"empty?", (void*(*)(void*))empty_Q, 1},
{"count", (void*(*)(void*))count, 1},
{"conj", (void*(*)(void*))sconj, -1},
diff --git a/c/core.h b/c/core.h
index 6668c53..a8b7a5f 100644
--- a/c/core.h
+++ b/c/core.h
@@ -3,20 +3,6 @@
#include <glib.h>
-// These are just used by step2 and step3 before then core_ns environment is
-// imported
-
-MalVal *int_plus(MalVal *a, MalVal *b);
-MalVal *int_minus(MalVal *a, MalVal *b);
-MalVal *int_multiply(MalVal *a, MalVal *b);
-MalVal *int_divide(MalVal *a, MalVal *b);
-
-// Useful for step implementation
-MalVal *first(MalVal *seq);
-MalVal *rest(MalVal *seq);
-MalVal *last(MalVal *seq);
-MalVal *hash_map(MalVal *args);
-
// namespace of type functions
typedef struct {
char *name;
@@ -24,6 +10,6 @@ typedef struct {
int arg_cnt;
} core_ns_entry;
-extern core_ns_entry core_ns[50];
+extern core_ns_entry core_ns[53];
#endif
diff --git a/c/step1_read_print.c b/c/step1_read_print.c
index 77c75b9..d28439e 100644
--- a/c/step1_read_print.c
+++ b/c/step1_read_print.c
@@ -1,6 +1,7 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
diff --git a/c/step2_eval.c b/c/step2_eval.c
index 85746f8..5d24ff0 100644
--- a/c/step2_eval.c
+++ b/c/step2_eval.c
@@ -1,10 +1,10 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
-#include "core.h"
// Declarations
MalVal *EVAL(MalVal *ast, GHashTable *env);
@@ -54,7 +54,7 @@ MalVal *eval_ast(MalVal *ast, GHashTable *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -62,8 +62,8 @@ MalVal *eval_ast(MalVal *ast, GHashTable *env) {
}
MalVal *EVAL(MalVal *ast, GHashTable *env) {
- //g_print("EVAL: %s\n", _pr_str(ast,1));
if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
if (ast->type != MAL_LIST) {
return eval_ast(ast, env);
}
@@ -76,7 +76,7 @@ MalVal *EVAL(MalVal *ast, GHashTable *env) {
assert_type(a0, MAL_SYMBOL, "Cannot invoke %s", _pr_str(a0,1));
MalVal *el = eval_ast(ast, env);
if (!el || mal_error) { return NULL; }
- MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))first(el);
+ MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el);
//g_print("eval_invoke el: %s\n", _pr_str(el,1));
return f(_nth(el, 1), _nth(el, 2));
}
@@ -109,9 +109,15 @@ MalVal *RE(GHashTable *env, char *prompt, char *str) {
// Setup the initial REPL environment
GHashTable *repl_env;
+
void init_repl_env() {
repl_env = g_hash_table_new(g_str_hash, g_str_equal);
+ WRAP_INTEGER_OP(plus,+)
+ WRAP_INTEGER_OP(minus,-)
+ WRAP_INTEGER_OP(multiply,*)
+ WRAP_INTEGER_OP(divide,/)
+
g_hash_table_insert(repl_env, "+", int_plus);
g_hash_table_insert(repl_env, "-", int_minus);
g_hash_table_insert(repl_env, "*", int_multiply);
diff --git a/c/step3_env.c b/c/step3_env.c
index 4abf4d6..7c36b38 100644
--- a/c/step3_env.c
+++ b/c/step3_env.c
@@ -1,10 +1,10 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
-#include "core.h"
// Declarations
MalVal *EVAL(MalVal *ast, Env *env);
@@ -53,7 +53,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -61,8 +61,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
}
MalVal *EVAL(MalVal *ast, Env *env) {
- //g_print("EVAL: %s\n", _pr_str(ast,1));
if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
if (ast->type != MAL_LIST) {
return eval_ast(ast, env);
}
@@ -102,7 +102,7 @@ MalVal *EVAL(MalVal *ast, Env *env) {
//g_print("eval apply\n");
MalVal *el = eval_ast(ast, env);
if (!el || mal_error) { return NULL; }
- MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))first(el);
+ MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el);
return f(_nth(el, 1), _nth(el, 2));
}
}
@@ -138,6 +138,11 @@ Env *repl_env;
void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
+ WRAP_INTEGER_OP(plus,+)
+ WRAP_INTEGER_OP(minus,-)
+ WRAP_INTEGER_OP(multiply,*)
+ WRAP_INTEGER_OP(divide,/)
+
env_set(repl_env, "+", (MalVal *)int_plus);
env_set(repl_env, "-", (MalVal *)int_minus);
env_set(repl_env, "*", (MalVal *)int_multiply);
diff --git a/c/step4_if_fn_do.c b/c/step4_if_fn_do.c
index 3662816..87e1241 100644
--- a/c/step4_if_fn_do.c
+++ b/c/step4_if_fn_do.c
@@ -1,6 +1,7 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
@@ -53,7 +54,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -61,8 +62,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
}
MalVal *EVAL(MalVal *ast, Env *env) {
- //g_print("EVAL: %s\n", _pr_str(ast,1));
if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
if (ast->type != MAL_LIST) {
return eval_ast(ast, env);
}
@@ -102,8 +103,8 @@ MalVal *EVAL(MalVal *ast, Env *env) {
} else if ((a0->type & MAL_SYMBOL) &&
strcmp("do", a0->val.string) == 0) {
//g_print("eval apply do\n");
- MalVal *el = eval_ast(rest(ast), env);
- return last(el);
+ MalVal *el = eval_ast(_rest(ast), env);
+ return _last(el);
} else if ((a0->type & MAL_SYMBOL) &&
strcmp("if", a0->val.string) == 0) {
//g_print("eval apply if\n");
@@ -136,8 +137,8 @@ MalVal *EVAL(MalVal *ast, Env *env) {
//g_print("eval apply\n");
MalVal *el = eval_ast(ast, env);
if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
+ MalVal *f = _first(el),
+ *args = _rest(el);
assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
"cannot apply '%s'", _pr_str(f,1));
return _apply(f, args);
@@ -173,18 +174,16 @@ MalVal *RE(Env *env, char *prompt, char *str) {
Env *repl_env;
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
}
diff --git a/c/step5_tco.c b/c/step5_tco.c
index 99d6826..6938e47 100644
--- a/c/step5_tco.c
+++ b/c/step5_tco.c
@@ -1,6 +1,7 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
@@ -53,7 +54,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -62,93 +63,95 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *EVAL(MalVal *ast, Env *env) {
while (TRUE) {
- //g_print("EVAL: %s\n", _pr_str(ast,1));
- if (!ast || mal_error) return NULL;
- if (ast->type != MAL_LIST) {
- return eval_ast(ast, env);
+
+ if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
+ if (ast->type != MAL_LIST) {
+ return eval_ast(ast, env);
+ }
+ if (!ast || mal_error) return NULL;
+
+ // apply list
+ //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+ int i, len;
+ if (_count(ast) == 0) { return ast; }
+ MalVal *a0 = _nth(ast, 0);
+ if ((a0->type & MAL_SYMBOL) &&
+ strcmp("def!", a0->val.string) == 0) {
+ //g_print("eval apply def!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("let*", a0->val.string) == 0) {
+ //g_print("eval apply let*\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2),
+ *key, *val;
+ assert_type(a1, MAL_LIST|MAL_VECTOR,
+ "let* bindings must be list or vector");
+ len = _count(a1);
+ assert((len % 2) == 0, "odd number of let* bindings forms");
+ Env *let_env = new_env(env, NULL, NULL);
+ for(i=0; i<len; i+=2) {
+ key = g_array_index(a1->val.array, MalVal*, i);
+ val = g_array_index(a1->val.array, MalVal*, i+1);
+ assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+ env_set(let_env, key->val.string, EVAL(val, let_env));
}
- if (!ast || mal_error) return NULL;
-
- // apply list
- //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
- int i, len;
- if (_count(ast) == 0) { return ast; }
- MalVal *a0 = _nth(ast, 0);
- if ((a0->type & MAL_SYMBOL) &&
- strcmp("def!", a0->val.string) == 0) {
- //g_print("eval apply def!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("let*", a0->val.string) == 0) {
- //g_print("eval apply let*\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2),
- *key, *val;
- assert_type(a1, MAL_LIST|MAL_VECTOR,
- "let* bindings must be list or vector");
- len = _count(a1);
- assert((len % 2) == 0, "odd number of let* bindings forms");
- Env *let_env = new_env(env, NULL, NULL);
- for(i=0; i<len; i+=2) {
- key = g_array_index(a1->val.array, MalVal*, i);
- val = g_array_index(a1->val.array, MalVal*, i+1);
- assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
- env_set(let_env, key->val.string, EVAL(val, let_env));
- }
- return EVAL(a2, let_env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("do", a0->val.string) == 0) {
- //g_print("eval apply do\n");
- eval_ast(_slice(ast, 1, _count(ast)-1), env);
- ast = last(ast);
- // Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("if", a0->val.string) == 0) {
- //g_print("eval apply if\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *cond = EVAL(a1, env);
- if (!cond || mal_error) return NULL;
- if (cond->type & (MAL_FALSE|MAL_NIL)) {
- // eval false slot form
- ast = _nth(ast, 3);
- if (!ast) {
- return &mal_nil;
- }
- } else {
- // eval true slot form
- ast = _nth(ast, 2);
+ return EVAL(a2, let_env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("do", a0->val.string) == 0) {
+ //g_print("eval apply do\n");
+ eval_ast(_slice(ast, 1, _count(ast)-1), env);
+ ast = _last(ast);
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("if", a0->val.string) == 0) {
+ //g_print("eval apply if\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *cond = EVAL(a1, env);
+ if (!cond || mal_error) return NULL;
+ if (cond->type & (MAL_FALSE|MAL_NIL)) {
+ // eval false slot form
+ ast = _nth(ast, 3);
+ if (!ast) {
+ return &mal_nil;
}
+ } else {
+ // eval true slot form
+ ast = _nth(ast, 2);
+ }
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("fn*", a0->val.string) == 0) {
+ //g_print("eval apply fn*\n");
+ MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+ mf->val.func.evaluator = EVAL;
+ mf->val.func.args = _nth(ast, 1);
+ mf->val.func.body = _nth(ast, 2);
+ mf->val.func.env = env;
+ return mf;
+ } else {
+ //g_print("eval apply\n");
+ MalVal *el = eval_ast(ast, env);
+ if (!el || mal_error) { return NULL; }
+ MalVal *f = _first(el),
+ *args = _rest(el);
+ assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "cannot apply '%s'", _pr_str(f,1));
+ if (f->type & MAL_FUNCTION_MAL) {
+ ast = f->val.func.body;
+ env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("fn*", a0->val.string) == 0) {
- //g_print("eval apply fn*\n");
- MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
- mf->val.func.evaluator = EVAL;
- mf->val.func.args = _nth(ast, 1);
- mf->val.func.body = _nth(ast, 2);
- mf->val.func.env = env;
- return mf;
} else {
- //g_print("eval apply\n");
- MalVal *el = eval_ast(ast, env);
- if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
- assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "cannot invoke '%s'", _pr_str(f,1));
- if (f->type & MAL_FUNCTION_MAL) {
- ast = f->val.func.body;
- env = new_env(f->val.func.env, f->val.func.args, args);
- // Continue loop
- } else {
- return _apply(f, args);
- }
+ return _apply(f, args);
}
}
+
+ } // TCO while loop
}
// print
@@ -180,18 +183,16 @@ MalVal *RE(Env *env, char *prompt, char *str) {
Env *repl_env;
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
}
diff --git a/c/step6_file.c b/c/step6_file.c
index acde758..ae48693 100644
--- a/c/step6_file.c
+++ b/c/step6_file.c
@@ -1,13 +1,11 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
-#include <sys/stat.h>
-#include <fcntl.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
#include "core.h"
-#include "interop.h"
// Declarations
MalVal *EVAL(MalVal *ast, Env *env);
@@ -56,7 +54,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -65,93 +63,95 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *EVAL(MalVal *ast, Env *env) {
while (TRUE) {
- //g_print("EVAL: %s\n", _pr_str(ast,1));
- if (!ast || mal_error) return NULL;
- if (ast->type != MAL_LIST) {
- return eval_ast(ast, env);
- }
- if (!ast || mal_error) return NULL;
- // apply list
- //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
- int i, len;
- if (_count(ast) == 0) { return ast; }
- MalVal *a0 = _nth(ast, 0);
- if ((a0->type & MAL_SYMBOL) &&
- strcmp("def!", a0->val.string) == 0) {
- //g_print("eval apply def!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("let*", a0->val.string) == 0) {
- //g_print("eval apply let*\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2),
- *key, *val;
- assert_type(a1, MAL_LIST|MAL_VECTOR,
- "let* bindings must be list or vector");
- len = _count(a1);
- assert((len % 2) == 0, "odd number of let* bindings forms");
- Env *let_env = new_env(env, NULL, NULL);
- for(i=0; i<len; i+=2) {
- key = g_array_index(a1->val.array, MalVal*, i);
- val = g_array_index(a1->val.array, MalVal*, i+1);
- assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
- env_set(let_env, key->val.string, EVAL(val, let_env));
- }
- return EVAL(a2, let_env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("do", a0->val.string) == 0) {
- //g_print("eval apply do\n");
- eval_ast(_slice(ast, 1, _count(ast)-1), env);
- ast = last(ast);
- // Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("if", a0->val.string) == 0) {
- //g_print("eval apply if\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *cond = EVAL(a1, env);
- if (!cond || mal_error) return NULL;
- if (cond->type & (MAL_FALSE|MAL_NIL)) {
- // eval false slot form
- ast = _nth(ast, 3);
- if (!ast) {
- return &mal_nil;
- }
- } else {
- // eval true slot form
- ast = _nth(ast, 2);
+ if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
+ if (ast->type != MAL_LIST) {
+ return eval_ast(ast, env);
+ }
+ if (!ast || mal_error) return NULL;
+
+ // apply list
+ //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+ int i, len;
+ if (_count(ast) == 0) { return ast; }
+ MalVal *a0 = _nth(ast, 0);
+ if ((a0->type & MAL_SYMBOL) &&
+ strcmp("def!", a0->val.string) == 0) {
+ //g_print("eval apply def!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("let*", a0->val.string) == 0) {
+ //g_print("eval apply let*\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2),
+ *key, *val;
+ assert_type(a1, MAL_LIST|MAL_VECTOR,
+ "let* bindings must be list or vector");
+ len = _count(a1);
+ assert((len % 2) == 0, "odd number of let* bindings forms");
+ Env *let_env = new_env(env, NULL, NULL);
+ for(i=0; i<len; i+=2) {
+ key = g_array_index(a1->val.array, MalVal*, i);
+ val = g_array_index(a1->val.array, MalVal*, i+1);
+ assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+ env_set(let_env, key->val.string, EVAL(val, let_env));
+ }
+ return EVAL(a2, let_env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("do", a0->val.string) == 0) {
+ //g_print("eval apply do\n");
+ eval_ast(_slice(ast, 1, _count(ast)-1), env);
+ ast = _last(ast);
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("if", a0->val.string) == 0) {
+ //g_print("eval apply if\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *cond = EVAL(a1, env);
+ if (!cond || mal_error) return NULL;
+ if (cond->type & (MAL_FALSE|MAL_NIL)) {
+ // eval false slot form
+ ast = _nth(ast, 3);
+ if (!ast) {
+ return &mal_nil;
}
+ } else {
+ // eval true slot form
+ ast = _nth(ast, 2);
+ }
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("fn*", a0->val.string) == 0) {
+ //g_print("eval apply fn*\n");
+ MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+ mf->val.func.evaluator = EVAL;
+ mf->val.func.args = _nth(ast, 1);
+ mf->val.func.body = _nth(ast, 2);
+ mf->val.func.env = env;
+ return mf;
+ } else {
+ //g_print("eval apply\n");
+ MalVal *el = eval_ast(ast, env);
+ if (!el || mal_error) { return NULL; }
+ MalVal *f = _first(el),
+ *args = _rest(el);
+ assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "cannot apply '%s'", _pr_str(f,1));
+ if (f->type & MAL_FUNCTION_MAL) {
+ ast = f->val.func.body;
+ env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("fn*", a0->val.string) == 0) {
- //g_print("eval apply fn*\n");
- MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
- mf->val.func.evaluator = EVAL;
- mf->val.func.args = _nth(ast, 1);
- mf->val.func.body = _nth(ast, 2);
- mf->val.func.env = env;
- return mf;
} else {
- //g_print("eval apply\n");
- MalVal *el = eval_ast(ast, env);
- if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
- assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "cannot invoke '%s'", _pr_str(f,1));
- if (f->type & MAL_FUNCTION_MAL) {
- ast = f->val.func.body;
- env = new_env(f->val.func.env, f->val.func.args, args);
- // Continue loop
- } else {
- return _apply(f, args);
- }
+ return _apply(f, args);
}
}
+
+ } // TCO while loop
}
// print
@@ -182,58 +182,20 @@ MalVal *RE(Env *env, char *prompt, char *str) {
// Setup the initial REPL environment
Env *repl_env;
-char *slurp_raw(char *path) {
- char *data;
- struct stat fst;
- int fd = open(path, O_RDONLY),
- sz;
- if (fd < 0) {
- abort("slurp failed to open '%s'", path);
- }
- if (fstat(fd, &fst) < 0) {
- abort("slurp failed to stat '%s'", path);
- }
- data = malloc(fst.st_size+1);
- sz = read(fd, data, fst.st_size);
- if (sz < fst.st_size) {
- abort("slurp failed to read '%s'", path);
- }
- data[sz] = '\0';
- return data;
-}
-
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
- }
-
- MalVal *read_string(MalVal *str) {
- assert_type(str, MAL_STRING, "read_string of non-string");
- return read_str(str->val.string);
- }
- _ref("read-string", read_string, 1);
-
- MalVal *do_eval(MalVal *ast) {
- return EVAL(ast, repl_env);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
- _ref("eval", do_eval, 1);
-
- MalVal *slurp(MalVal *path) {
- assert_type(path, MAL_STRING, "slurp of non-string");
- char *data = slurp_raw(path->val.string);
- if (!data || mal_error) { return NULL; }
- return malval_new_string(data);
- }
- _ref("slurp", slurp, 1);
+ MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); }
+ env_set(repl_env, "eval",
+ malval_new_function((void*(*)(void *))do_eval, 1));
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
@@ -252,21 +214,22 @@ int main(int argc, char *argv[])
if (argc > 1) {
char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
RE(repl_env, "", cmd);
- } else {
- // REPL loop
- for(;;) {
- exp = RE(repl_env, prompt, NULL);
- if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
- return 0;
- }
- output = PRINT(exp);
+ return 0;
+ }
- if (output) {
- g_print("%s\n", output);
- free(output); // Free output string
- }
+ // REPL loop
+ for(;;) {
+ exp = RE(repl_env, prompt, NULL);
+ if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
+ return 0;
+ }
+ output = PRINT(exp);
- //malval_free(exp); // Free evaluated expression
+ if (output) {
+ g_print("%s\n", output);
+ free(output); // Free output string
}
+
+ //malval_free(exp); // Free evaluated expression
}
}
diff --git a/c/step7_quote.c b/c/step7_quote.c
index 7da47ee..ac17955 100644
--- a/c/step7_quote.c
+++ b/c/step7_quote.c
@@ -1,13 +1,11 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
-#include <sys/stat.h>
-#include <fcntl.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
#include "core.h"
-#include "interop.h"
// Declarations
MalVal *EVAL(MalVal *ast, Env *env);
@@ -49,12 +47,12 @@ MalVal *quasiquote(MalVal *ast) {
strcmp("splice-unquote", a00->val.string) == 0) {
return _listX(3, malval_new_symbol("concat"),
_nth(a0, 1),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
return _listX(3, malval_new_symbol("cons"),
quasiquote(a0),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
@@ -83,7 +81,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -92,102 +90,104 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *EVAL(MalVal *ast, Env *env) {
while (TRUE) {
- if (!ast || mal_error) return NULL;
- //g_print("EVAL: %s\n", _pr_str(ast,1));
- if (ast->type != MAL_LIST) {
- return eval_ast(ast, env);
- }
- if (!ast || mal_error) return NULL;
- // apply list
- //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
- int i, len;
- if (_count(ast) == 0) { return ast; }
- MalVal *a0 = _nth(ast, 0);
- if ((a0->type & MAL_SYMBOL) &&
- strcmp("def!", a0->val.string) == 0) {
- //g_print("eval apply def!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("let*", a0->val.string) == 0) {
- //g_print("eval apply let*\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2),
- *key, *val;
- assert_type(a1, MAL_LIST|MAL_VECTOR,
- "let* bindings must be list or vector");
- len = _count(a1);
- assert((len % 2) == 0, "odd number of let* bindings forms");
- Env *let_env = new_env(env, NULL, NULL);
- for(i=0; i<len; i+=2) {
- key = g_array_index(a1->val.array, MalVal*, i);
- val = g_array_index(a1->val.array, MalVal*, i+1);
- assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
- env_set(let_env, key->val.string, EVAL(val, let_env));
- }
- return EVAL(a2, let_env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quote", a0->val.string) == 0) {
- //g_print("eval apply quote\n");
- return _nth(ast, 1);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quasiquote", a0->val.string) == 0) {
- //g_print("eval apply quasiquote\n");
- MalVal *a1 = _nth(ast, 1);
- return EVAL(quasiquote(a1), env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("do", a0->val.string) == 0) {
- //g_print("eval apply do\n");
- eval_ast(_slice(ast, 1, _count(ast)-1), env);
- ast = last(ast);
- // Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("if", a0->val.string) == 0) {
- //g_print("eval apply if\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *cond = EVAL(a1, env);
- if (!cond || mal_error) return NULL;
- if (cond->type & (MAL_FALSE|MAL_NIL)) {
- // eval false slot form
- ast = _nth(ast, 3);
- if (!ast) {
- return &mal_nil;
- }
- } else {
- // eval true slot form
- ast = _nth(ast, 2);
+ if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
+ if (ast->type != MAL_LIST) {
+ return eval_ast(ast, env);
+ }
+ if (!ast || mal_error) return NULL;
+
+ // apply list
+ //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+ int i, len;
+ if (_count(ast) == 0) { return ast; }
+ MalVal *a0 = _nth(ast, 0);
+ if ((a0->type & MAL_SYMBOL) &&
+ strcmp("def!", a0->val.string) == 0) {
+ //g_print("eval apply def!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("let*", a0->val.string) == 0) {
+ //g_print("eval apply let*\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2),
+ *key, *val;
+ assert_type(a1, MAL_LIST|MAL_VECTOR,
+ "let* bindings must be list or vector");
+ len = _count(a1);
+ assert((len % 2) == 0, "odd number of let* bindings forms");
+ Env *let_env = new_env(env, NULL, NULL);
+ for(i=0; i<len; i+=2) {
+ key = g_array_index(a1->val.array, MalVal*, i);
+ val = g_array_index(a1->val.array, MalVal*, i+1);
+ assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+ env_set(let_env, key->val.string, EVAL(val, let_env));
+ }
+ return EVAL(a2, let_env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quote", a0->val.string) == 0) {
+ //g_print("eval apply quote\n");
+ return _nth(ast, 1);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quasiquote", a0->val.string) == 0) {
+ //g_print("eval apply quasiquote\n");
+ MalVal *a1 = _nth(ast, 1);
+ return EVAL(quasiquote(a1), env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("do", a0->val.string) == 0) {
+ //g_print("eval apply do\n");
+ eval_ast(_slice(ast, 1, _count(ast)-1), env);
+ ast = _last(ast);
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("if", a0->val.string) == 0) {
+ //g_print("eval apply if\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *cond = EVAL(a1, env);
+ if (!cond || mal_error) return NULL;
+ if (cond->type & (MAL_FALSE|MAL_NIL)) {
+ // eval false slot form
+ ast = _nth(ast, 3);
+ if (!ast) {
+ return &mal_nil;
}
+ } else {
+ // eval true slot form
+ ast = _nth(ast, 2);
+ }
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("fn*", a0->val.string) == 0) {
+ //g_print("eval apply fn*\n");
+ MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+ mf->val.func.evaluator = EVAL;
+ mf->val.func.args = _nth(ast, 1);
+ mf->val.func.body = _nth(ast, 2);
+ mf->val.func.env = env;
+ return mf;
+ } else {
+ //g_print("eval apply\n");
+ MalVal *el = eval_ast(ast, env);
+ if (!el || mal_error) { return NULL; }
+ MalVal *f = _first(el),
+ *args = _rest(el);
+ assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "cannot apply '%s'", _pr_str(f,1));
+ if (f->type & MAL_FUNCTION_MAL) {
+ ast = f->val.func.body;
+ env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("fn*", a0->val.string) == 0) {
- //g_print("eval apply fn*\n");
- MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
- mf->val.func.evaluator = EVAL;
- mf->val.func.args = _nth(ast, 1);
- mf->val.func.body = _nth(ast, 2);
- mf->val.func.env = env;
- return mf;
} else {
- //g_print("eval apply\n");
- MalVal *el = eval_ast(ast, env);
- if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
- assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "cannot invoke '%s'", _pr_str(f,1));
- if (f->type & MAL_FUNCTION_MAL) {
- ast = f->val.func.body;
- env = new_env(f->val.func.env, f->val.func.args, args);
- // Continue loop
- } else {
- return _apply(f, args);
- }
+ return _apply(f, args);
}
}
+
+ } // TCO while loop
}
// print
@@ -218,58 +218,20 @@ MalVal *RE(Env *env, char *prompt, char *str) {
// Setup the initial REPL environment
Env *repl_env;
-char *slurp_raw(char *path) {
- char *data;
- struct stat fst;
- int fd = open(path, O_RDONLY),
- sz;
- if (fd < 0) {
- abort("slurp failed to open '%s'", path);
- }
- if (fstat(fd, &fst) < 0) {
- abort("slurp failed to stat '%s'", path);
- }
- data = malloc(fst.st_size+1);
- sz = read(fd, data, fst.st_size);
- if (sz < fst.st_size) {
- abort("slurp failed to read '%s'", path);
- }
- data[sz] = '\0';
- return data;
-}
-
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
- }
-
- MalVal *read_string(MalVal *str) {
- assert_type(str, MAL_STRING, "read_string of non-string");
- return read_str(str->val.string);
- }
- _ref("read-string", read_string, 1);
-
- MalVal *do_eval(MalVal *ast) {
- return EVAL(ast, repl_env);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
- _ref("eval", do_eval, 1);
-
- MalVal *slurp(MalVal *path) {
- assert_type(path, MAL_STRING, "slurp of non-string");
- char *data = slurp_raw(path->val.string);
- if (!data || mal_error) { return NULL; }
- return malval_new_string(data);
- }
- _ref("slurp", slurp, 1);
+ MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); }
+ env_set(repl_env, "eval",
+ malval_new_function((void*(*)(void *))do_eval, 1));
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
@@ -288,21 +250,22 @@ int main(int argc, char *argv[])
if (argc > 1) {
char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
RE(repl_env, "", cmd);
- } else {
- // REPL loop
- for(;;) {
- exp = RE(repl_env, prompt, NULL);
- if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
- return 0;
- }
- output = PRINT(exp);
+ return 0;
+ }
- if (output) {
- g_print("%s\n", output);
- free(output); // Free output string
- }
+ // REPL loop
+ for(;;) {
+ exp = RE(repl_env, prompt, NULL);
+ if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
+ return 0;
+ }
+ output = PRINT(exp);
- //malval_free(exp); // Free evaluated expression
+ if (output) {
+ g_print("%s\n", output);
+ free(output); // Free output string
}
+
+ //malval_free(exp); // Free evaluated expression
}
}
diff --git a/c/step8_macros.c b/c/step8_macros.c
index eb715b1..93c83fa 100644
--- a/c/step8_macros.c
+++ b/c/step8_macros.c
@@ -1,13 +1,11 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
-#include <sys/stat.h>
-#include <fcntl.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
#include "core.h"
-#include "interop.h"
// Declarations
MalVal *EVAL(MalVal *ast, Env *env);
@@ -50,12 +48,12 @@ MalVal *quasiquote(MalVal *ast) {
strcmp("splice-unquote", a00->val.string) == 0) {
return _listX(3, malval_new_symbol("concat"),
_nth(a0, 1),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
return _listX(3, malval_new_symbol("cons"),
quasiquote(a0),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
@@ -73,7 +71,7 @@ MalVal *macroexpand(MalVal *ast, Env *env) {
MalVal *a0 = _nth(ast, 0);
MalVal *mac = env_get(env, a0->val.string);
// TODO: this is weird and limits it to 20. FIXME
- ast = _apply(mac, rest(ast));
+ ast = _apply(mac, _rest(ast));
}
return ast;
}
@@ -103,7 +101,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -112,121 +110,123 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *EVAL(MalVal *ast, Env *env) {
while (TRUE) {
- if (!ast || mal_error) return NULL;
- //g_print("EVAL: %s\n", _pr_str(ast,1));
- if (ast->type != MAL_LIST) {
- return eval_ast(ast, env);
- }
- if (!ast || mal_error) return NULL;
- // apply list
- //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
- ast = macroexpand(ast, env);
- if (!ast || mal_error) return NULL;
- if (ast->type != MAL_LIST) { return ast; }
- if (_count(ast) == 0) { return ast; }
+ if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
+ if (ast->type != MAL_LIST) {
+ return eval_ast(ast, env);
+ }
+ if (!ast || mal_error) return NULL;
- int i, len;
- MalVal *a0 = _nth(ast, 0);
- if ((a0->type & MAL_SYMBOL) &&
- strcmp("def!", a0->val.string) == 0) {
- //g_print("eval apply def!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("let*", a0->val.string) == 0) {
- //g_print("eval apply let*\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2),
- *key, *val;
- assert_type(a1, MAL_LIST|MAL_VECTOR,
- "let* bindings must be list or vector");
- len = _count(a1);
- assert((len % 2) == 0, "odd number of let* bindings forms");
- Env *let_env = new_env(env, NULL, NULL);
- for(i=0; i<len; i+=2) {
- key = g_array_index(a1->val.array, MalVal*, i);
- val = g_array_index(a1->val.array, MalVal*, i+1);
- assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
- env_set(let_env, key->val.string, EVAL(val, let_env));
- }
- return EVAL(a2, let_env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quote", a0->val.string) == 0) {
- //g_print("eval apply quote\n");
- return _nth(ast, 1);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quasiquote", a0->val.string) == 0) {
- //g_print("eval apply quasiquote\n");
- MalVal *a1 = _nth(ast, 1);
- return EVAL(quasiquote(a1), env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("defmacro!", a0->val.string) == 0) {
- //g_print("eval apply defmacro!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- res->ismacro = TRUE;
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("macroexpand", a0->val.string) == 0) {
- //g_print("eval apply macroexpand\n");
- MalVal *a1 = _nth(ast, 1);
- return macroexpand(a1, env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("do", a0->val.string) == 0) {
- //g_print("eval apply do\n");
- eval_ast(_slice(ast, 1, _count(ast)-1), env);
- ast = last(ast);
- // Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("if", a0->val.string) == 0) {
- //g_print("eval apply if\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *cond = EVAL(a1, env);
- if (!cond || mal_error) return NULL;
- if (cond->type & (MAL_FALSE|MAL_NIL)) {
- // eval false slot form
- ast = _nth(ast, 3);
- if (!ast) {
- return &mal_nil;
- }
- } else {
- // eval true slot form
- ast = _nth(ast, 2);
+ // apply list
+ //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+ ast = macroexpand(ast, env);
+ if (!ast || mal_error) return NULL;
+ if (ast->type != MAL_LIST) { return ast; }
+ if (_count(ast) == 0) { return ast; }
+
+ int i, len;
+ MalVal *a0 = _nth(ast, 0);
+ if ((a0->type & MAL_SYMBOL) &&
+ strcmp("def!", a0->val.string) == 0) {
+ //g_print("eval apply def!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("let*", a0->val.string) == 0) {
+ //g_print("eval apply let*\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2),
+ *key, *val;
+ assert_type(a1, MAL_LIST|MAL_VECTOR,
+ "let* bindings must be list or vector");
+ len = _count(a1);
+ assert((len % 2) == 0, "odd number of let* bindings forms");
+ Env *let_env = new_env(env, NULL, NULL);
+ for(i=0; i<len; i+=2) {
+ key = g_array_index(a1->val.array, MalVal*, i);
+ val = g_array_index(a1->val.array, MalVal*, i+1);
+ assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+ env_set(let_env, key->val.string, EVAL(val, let_env));
+ }
+ return EVAL(a2, let_env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quote", a0->val.string) == 0) {
+ //g_print("eval apply quote\n");
+ return _nth(ast, 1);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quasiquote", a0->val.string) == 0) {
+ //g_print("eval apply quasiquote\n");
+ MalVal *a1 = _nth(ast, 1);
+ return EVAL(quasiquote(a1), env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("defmacro!", a0->val.string) == 0) {
+ //g_print("eval apply defmacro!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ res->ismacro = TRUE;
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("macroexpand", a0->val.string) == 0) {
+ //g_print("eval apply macroexpand\n");
+ MalVal *a1 = _nth(ast, 1);
+ return macroexpand(a1, env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("do", a0->val.string) == 0) {
+ //g_print("eval apply do\n");
+ eval_ast(_slice(ast, 1, _count(ast)-1), env);
+ ast = _last(ast);
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("if", a0->val.string) == 0) {
+ //g_print("eval apply if\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *cond = EVAL(a1, env);
+ if (!cond || mal_error) return NULL;
+ if (cond->type & (MAL_FALSE|MAL_NIL)) {
+ // eval false slot form
+ ast = _nth(ast, 3);
+ if (!ast) {
+ return &mal_nil;
}
+ } else {
+ // eval true slot form
+ ast = _nth(ast, 2);
+ }
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("fn*", a0->val.string) == 0) {
+ //g_print("eval apply fn*\n");
+ MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+ mf->ismacro = FALSE;
+ mf->val.func.evaluator = EVAL;
+ mf->val.func.args = _nth(ast, 1);
+ mf->val.func.body = _nth(ast, 2);
+ mf->val.func.env = env;
+ return mf;
+ } else {
+ //g_print("eval apply\n");
+ MalVal *el = eval_ast(ast, env);
+ if (!el || mal_error) { return NULL; }
+ MalVal *f = _first(el),
+ *args = _rest(el);
+ assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "cannot apply '%s'", _pr_str(f,1));
+ if (f->type & MAL_FUNCTION_MAL) {
+ ast = f->val.func.body;
+ env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("fn*", a0->val.string) == 0) {
- //g_print("eval apply fn*\n");
- MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
- mf->ismacro = FALSE;
- mf->val.func.evaluator = EVAL;
- mf->val.func.args = _nth(ast, 1);
- mf->val.func.body = _nth(ast, 2);
- mf->val.func.env = env;
- return mf;
} else {
- //g_print("eval apply\n");
- MalVal *el = eval_ast(ast, env);
- if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
- assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "cannot invoke '%s'", _pr_str(f,1));
- if (f->type & MAL_FUNCTION_MAL) {
- ast = f->val.func.body;
- env = new_env(f->val.func.env, f->val.func.args, args);
- // Continue loop
- } else {
- return _apply(f, args);
- }
+ return _apply(f, args);
}
}
+
+ } // TCO while loop
}
// print
@@ -257,61 +257,25 @@ MalVal *RE(Env *env, char *prompt, char *str) {
// Setup the initial REPL environment
Env *repl_env;
-char *slurp_raw(char *path) {
- char *data;
- struct stat fst;
- int fd = open(path, O_RDONLY),
- sz;
- if (fd < 0) {
- abort("slurp failed to open '%s'", path);
- }
- if (fstat(fd, &fst) < 0) {
- abort("slurp failed to stat '%s'", path);
- }
- data = malloc(fst.st_size+1);
- sz = read(fd, data, fst.st_size);
- if (sz < fst.st_size) {
- abort("slurp failed to read '%s'", path);
- }
- data[sz] = '\0';
- return data;
-}
-
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
- }
-
- MalVal *read_string(MalVal *str) {
- assert_type(str, MAL_STRING, "read_string of non-string");
- return read_str(str->val.string);
- }
- _ref("read-string", read_string, 1);
-
- MalVal *do_eval(MalVal *ast) {
- return EVAL(ast, repl_env);
- }
- _ref("eval", do_eval, 1);
-
- MalVal *slurp(MalVal *path) {
- assert_type(path, MAL_STRING, "slurp of non-string");
- char *data = slurp_raw(path->val.string);
- if (!data || mal_error) { return NULL; }
- return malval_new_string(data);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
- _ref("slurp", slurp, 1);
+ MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); }
+ env_set(repl_env, "eval",
+ malval_new_function((void*(*)(void *))do_eval, 1));
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
+ RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
+ RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
}
int main(int argc, char *argv[])
@@ -327,21 +291,22 @@ int main(int argc, char *argv[])
if (argc > 1) {
char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
RE(repl_env, "", cmd);
- } else {
- // REPL loop
- for(;;) {
- exp = RE(repl_env, prompt, NULL);
- if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
- return 0;
- }
- output = PRINT(exp);
+ return 0;
+ }
- if (output) {
- g_print("%s\n", output);
- free(output); // Free output string
- }
+ // REPL loop
+ for(;;) {
+ exp = RE(repl_env, prompt, NULL);
+ if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
+ return 0;
+ }
+ output = PRINT(exp);
- //malval_free(exp); // Free evaluated expression
+ if (output) {
+ g_print("%s\n", output);
+ free(output); // Free output string
}
+
+ //malval_free(exp); // Free evaluated expression
}
}
diff --git a/c/step9_interop.c b/c/step9_interop.c
index dcd1526..743fb22 100644
--- a/c/step9_interop.c
+++ b/c/step9_interop.c
@@ -1,8 +1,7 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
-#include <sys/stat.h>
-#include <fcntl.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
@@ -50,12 +49,12 @@ MalVal *quasiquote(MalVal *ast) {
strcmp("splice-unquote", a00->val.string) == 0) {
return _listX(3, malval_new_symbol("concat"),
_nth(a0, 1),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
return _listX(3, malval_new_symbol("cons"),
quasiquote(a0),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
@@ -73,7 +72,7 @@ MalVal *macroexpand(MalVal *ast, Env *env) {
MalVal *a0 = _nth(ast, 0);
MalVal *mac = env_get(env, a0->val.string);
// TODO: this is weird and limits it to 20. FIXME
- ast = _apply(mac, rest(ast));
+ ast = _apply(mac, _rest(ast));
}
return ast;
}
@@ -103,7 +102,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -112,126 +111,128 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *EVAL(MalVal *ast, Env *env) {
while (TRUE) {
- if (!ast || mal_error) return NULL;
- //g_print("EVAL: %s\n", _pr_str(ast,1));
- if (ast->type != MAL_LIST) {
- return eval_ast(ast, env);
- }
- if (!ast || mal_error) return NULL;
- // apply list
- //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
- ast = macroexpand(ast, env);
- if (!ast || mal_error) return NULL;
- if (ast->type != MAL_LIST) { return ast; }
- if (_count(ast) == 0) { return ast; }
+ if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
+ if (ast->type != MAL_LIST) {
+ return eval_ast(ast, env);
+ }
+ if (!ast || mal_error) return NULL;
- int i, len;
- MalVal *a0 = _nth(ast, 0);
- if ((a0->type & MAL_SYMBOL) &&
- strcmp("def!", a0->val.string) == 0) {
- //g_print("eval apply def!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("let*", a0->val.string) == 0) {
- //g_print("eval apply let*\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2),
- *key, *val;
- assert_type(a1, MAL_LIST|MAL_VECTOR,
- "let* bindings must be list or vector");
- len = _count(a1);
- assert((len % 2) == 0, "odd number of let* bindings forms");
- Env *let_env = new_env(env, NULL, NULL);
- for(i=0; i<len; i+=2) {
- key = g_array_index(a1->val.array, MalVal*, i);
- val = g_array_index(a1->val.array, MalVal*, i+1);
- assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
- env_set(let_env, key->val.string, EVAL(val, let_env));
- }
- return EVAL(a2, let_env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quote", a0->val.string) == 0) {
- //g_print("eval apply quote\n");
- return _nth(ast, 1);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quasiquote", a0->val.string) == 0) {
- //g_print("eval apply quasiquote\n");
- MalVal *a1 = _nth(ast, 1);
- return EVAL(quasiquote(a1), env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("defmacro!", a0->val.string) == 0) {
- //g_print("eval apply defmacro!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- res->ismacro = TRUE;
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("macroexpand", a0->val.string) == 0) {
- //g_print("eval apply macroexpand\n");
- MalVal *a1 = _nth(ast, 1);
- return macroexpand(a1, env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp(".", a0->val.string) == 0) {
- //g_print("eval apply .\n");
- MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env);
- return invoke_native(el);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("do", a0->val.string) == 0) {
- //g_print("eval apply do\n");
- eval_ast(_slice(ast, 1, _count(ast)-1), env);
- ast = last(ast);
- // Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("if", a0->val.string) == 0) {
- //g_print("eval apply if\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *cond = EVAL(a1, env);
- if (!cond || mal_error) return NULL;
- if (cond->type & (MAL_FALSE|MAL_NIL)) {
- // eval false slot form
- ast = _nth(ast, 3);
- if (!ast) {
- return &mal_nil;
- }
- } else {
- // eval true slot form
- ast = _nth(ast, 2);
+ // apply list
+ //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+ ast = macroexpand(ast, env);
+ if (!ast || mal_error) return NULL;
+ if (ast->type != MAL_LIST) { return ast; }
+ if (_count(ast) == 0) { return ast; }
+
+ int i, len;
+ MalVal *a0 = _nth(ast, 0);
+ if ((a0->type & MAL_SYMBOL) &&
+ strcmp("def!", a0->val.string) == 0) {
+ //g_print("eval apply def!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("let*", a0->val.string) == 0) {
+ //g_print("eval apply let*\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2),
+ *key, *val;
+ assert_type(a1, MAL_LIST|MAL_VECTOR,
+ "let* bindings must be list or vector");
+ len = _count(a1);
+ assert((len % 2) == 0, "odd number of let* bindings forms");
+ Env *let_env = new_env(env, NULL, NULL);
+ for(i=0; i<len; i+=2) {
+ key = g_array_index(a1->val.array, MalVal*, i);
+ val = g_array_index(a1->val.array, MalVal*, i+1);
+ assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+ env_set(let_env, key->val.string, EVAL(val, let_env));
+ }
+ return EVAL(a2, let_env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quote", a0->val.string) == 0) {
+ //g_print("eval apply quote\n");
+ return _nth(ast, 1);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quasiquote", a0->val.string) == 0) {
+ //g_print("eval apply quasiquote\n");
+ MalVal *a1 = _nth(ast, 1);
+ return EVAL(quasiquote(a1), env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("defmacro!", a0->val.string) == 0) {
+ //g_print("eval apply defmacro!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ res->ismacro = TRUE;
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("macroexpand", a0->val.string) == 0) {
+ //g_print("eval apply macroexpand\n");
+ MalVal *a1 = _nth(ast, 1);
+ return macroexpand(a1, env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp(".", a0->val.string) == 0) {
+ //g_print("eval apply .\n");
+ MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env);
+ return invoke_native(el);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("do", a0->val.string) == 0) {
+ //g_print("eval apply do\n");
+ eval_ast(_slice(ast, 1, _count(ast)-1), env);
+ ast = _last(ast);
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("if", a0->val.string) == 0) {
+ //g_print("eval apply if\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *cond = EVAL(a1, env);
+ if (!cond || mal_error) return NULL;
+ if (cond->type & (MAL_FALSE|MAL_NIL)) {
+ // eval false slot form
+ ast = _nth(ast, 3);
+ if (!ast) {
+ return &mal_nil;
}
+ } else {
+ // eval true slot form
+ ast = _nth(ast, 2);
+ }
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("fn*", a0->val.string) == 0) {
+ //g_print("eval apply fn*\n");
+ MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+ mf->ismacro = FALSE;
+ mf->val.func.evaluator = EVAL;
+ mf->val.func.args = _nth(ast, 1);
+ mf->val.func.body = _nth(ast, 2);
+ mf->val.func.env = env;
+ return mf;
+ } else {
+ //g_print("eval apply\n");
+ MalVal *el = eval_ast(ast, env);
+ if (!el || mal_error) { return NULL; }
+ MalVal *f = _first(el),
+ *args = _rest(el);
+ assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "cannot apply '%s'", _pr_str(f,1));
+ if (f->type & MAL_FUNCTION_MAL) {
+ ast = f->val.func.body;
+ env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("fn*", a0->val.string) == 0) {
- //g_print("eval apply fn*\n");
- MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
- mf->ismacro = FALSE;
- mf->val.func.evaluator = EVAL;
- mf->val.func.args = _nth(ast, 1);
- mf->val.func.body = _nth(ast, 2);
- mf->val.func.env = env;
- return mf;
} else {
- //g_print("eval apply\n");
- MalVal *el = eval_ast(ast, env);
- if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
- assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "cannot invoke '%s'", _pr_str(f,1));
- if (f->type & MAL_FUNCTION_MAL) {
- ast = f->val.func.body;
- env = new_env(f->val.func.env, f->val.func.args, args);
- // Continue loop
- } else {
- return _apply(f, args);
- }
+ return _apply(f, args);
}
}
+
+ } // TCO while loop
}
// print
@@ -262,61 +263,25 @@ MalVal *RE(Env *env, char *prompt, char *str) {
// Setup the initial REPL environment
Env *repl_env;
-char *slurp_raw(char *path) {
- char *data;
- struct stat fst;
- int fd = open(path, O_RDONLY),
- sz;
- if (fd < 0) {
- abort("slurp failed to open '%s'", path);
- }
- if (fstat(fd, &fst) < 0) {
- abort("slurp failed to stat '%s'", path);
- }
- data = malloc(fst.st_size+1);
- sz = read(fd, data, fst.st_size);
- if (sz < fst.st_size) {
- abort("slurp failed to read '%s'", path);
- }
- data[sz] = '\0';
- return data;
-}
-
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
- }
-
- MalVal *read_string(MalVal *str) {
- assert_type(str, MAL_STRING, "read_string of non-string");
- return read_str(str->val.string);
- }
- _ref("read-string", read_string, 1);
-
- MalVal *do_eval(MalVal *ast) {
- return EVAL(ast, repl_env);
- }
- _ref("eval", do_eval, 1);
-
- MalVal *slurp(MalVal *path) {
- assert_type(path, MAL_STRING, "slurp of non-string");
- char *data = slurp_raw(path->val.string);
- if (!data || mal_error) { return NULL; }
- return malval_new_string(data);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
- _ref("slurp", slurp, 1);
+ MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); }
+ env_set(repl_env, "eval",
+ malval_new_function((void*(*)(void *))do_eval, 1));
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
+ RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
+ RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
}
int main(int argc, char *argv[])
@@ -332,21 +297,22 @@ int main(int argc, char *argv[])
if (argc > 1) {
char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
RE(repl_env, "", cmd);
- } else {
- // REPL loop
- for(;;) {
- exp = RE(repl_env, prompt, NULL);
- if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
- return 0;
- }
- output = PRINT(exp);
+ return 0;
+ }
- if (output) {
- g_print("%s\n", output);
- free(output); // Free output string
- }
+ // REPL loop
+ for(;;) {
+ exp = RE(repl_env, prompt, NULL);
+ if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
+ return 0;
+ }
+ output = PRINT(exp);
- //malval_free(exp); // Free evaluated expression
+ if (output) {
+ g_print("%s\n", output);
+ free(output); // Free output string
}
+
+ //malval_free(exp); // Free evaluated expression
}
}
diff --git a/c/stepA_more.c b/c/stepA_more.c
index 4e4152c..82bf3db 100644
--- a/c/stepA_more.c
+++ b/c/stepA_more.c
@@ -1,8 +1,7 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
-#include <sys/stat.h>
-#include <fcntl.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
@@ -50,12 +49,12 @@ MalVal *quasiquote(MalVal *ast) {
strcmp("splice-unquote", a00->val.string) == 0) {
return _listX(3, malval_new_symbol("concat"),
_nth(a0, 1),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
return _listX(3, malval_new_symbol("cons"),
quasiquote(a0),
- quasiquote(rest(ast)));
+ quasiquote(_rest(ast)));
}
}
@@ -73,7 +72,7 @@ MalVal *macroexpand(MalVal *ast, Env *env) {
MalVal *a0 = _nth(ast, 0);
MalVal *mac = env_get(env, a0->val.string);
// TODO: this is weird and limits it to 20. FIXME
- ast = _apply(mac, rest(ast));
+ ast = _apply(mac, _rest(ast));
}
return ast;
}
@@ -103,7 +102,7 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
@@ -112,147 +111,149 @@ MalVal *eval_ast(MalVal *ast, Env *env) {
MalVal *EVAL(MalVal *ast, Env *env) {
while (TRUE) {
- if (!ast || mal_error) return NULL;
- //g_print("EVAL: %s\n", _pr_str(ast,1));
- if (ast->type != MAL_LIST) {
- return eval_ast(ast, env);
- }
- if (!ast || mal_error) return NULL;
- // apply list
- //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
- ast = macroexpand(ast, env);
- if (!ast || mal_error) return NULL;
- if (ast->type != MAL_LIST) { return ast; }
- if (_count(ast) == 0) { return ast; }
+ if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
+ if (ast->type != MAL_LIST) {
+ return eval_ast(ast, env);
+ }
+ if (!ast || mal_error) return NULL;
- int i, len;
- MalVal *a0 = _nth(ast, 0);
- if ((a0->type & MAL_SYMBOL) &&
- strcmp("def!", a0->val.string) == 0) {
- //g_print("eval apply def!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("let*", a0->val.string) == 0) {
- //g_print("eval apply let*\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2),
- *key, *val;
- assert_type(a1, MAL_LIST|MAL_VECTOR,
- "let* bindings must be list or vector");
- len = _count(a1);
- assert((len % 2) == 0, "odd number of let* bindings forms");
- Env *let_env = new_env(env, NULL, NULL);
- for(i=0; i<len; i+=2) {
- key = g_array_index(a1->val.array, MalVal*, i);
- val = g_array_index(a1->val.array, MalVal*, i+1);
- assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
- env_set(let_env, key->val.string, EVAL(val, let_env));
- }
- return EVAL(a2, let_env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quote", a0->val.string) == 0) {
- //g_print("eval apply quote\n");
- return _nth(ast, 1);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("quasiquote", a0->val.string) == 0) {
- //g_print("eval apply quasiquote\n");
- MalVal *a1 = _nth(ast, 1);
- return EVAL(quasiquote(a1), env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("defmacro!", a0->val.string) == 0) {
- //g_print("eval apply defmacro!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- res->ismacro = TRUE;
- env_set(env, a1->val.string, res);
+ // apply list
+ //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+ ast = macroexpand(ast, env);
+ if (!ast || mal_error) return NULL;
+ if (ast->type != MAL_LIST) { return ast; }
+ if (_count(ast) == 0) { return ast; }
+
+ int i, len;
+ MalVal *a0 = _nth(ast, 0);
+ if ((a0->type & MAL_SYMBOL) &&
+ strcmp("def!", a0->val.string) == 0) {
+ //g_print("eval apply def!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("let*", a0->val.string) == 0) {
+ //g_print("eval apply let*\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2),
+ *key, *val;
+ assert_type(a1, MAL_LIST|MAL_VECTOR,
+ "let* bindings must be list or vector");
+ len = _count(a1);
+ assert((len % 2) == 0, "odd number of let* bindings forms");
+ Env *let_env = new_env(env, NULL, NULL);
+ for(i=0; i<len; i+=2) {
+ key = g_array_index(a1->val.array, MalVal*, i);
+ val = g_array_index(a1->val.array, MalVal*, i+1);
+ assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+ env_set(let_env, key->val.string, EVAL(val, let_env));
+ }
+ return EVAL(a2, let_env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quote", a0->val.string) == 0) {
+ //g_print("eval apply quote\n");
+ return _nth(ast, 1);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("quasiquote", a0->val.string) == 0) {
+ //g_print("eval apply quasiquote\n");
+ MalVal *a1 = _nth(ast, 1);
+ return EVAL(quasiquote(a1), env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("defmacro!", a0->val.string) == 0) {
+ //g_print("eval apply defmacro!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ res->ismacro = TRUE;
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("macroexpand", a0->val.string) == 0) {
+ //g_print("eval apply macroexpand\n");
+ MalVal *a1 = _nth(ast, 1);
+ return macroexpand(a1, env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp(".", a0->val.string) == 0) {
+ //g_print("eval apply .\n");
+ MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env);
+ return invoke_native(el);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("try*", a0->val.string) == 0) {
+ //g_print("eval apply try*\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a1, env);
+ if (!mal_error) { return res; }
+ MalVal *a20 = _nth(a2, 0);
+ if (strcmp("catch*", a20->val.string) == 0) {
+ MalVal *a21 = _nth(a2, 1);
+ MalVal *a22 = _nth(a2, 2);
+ Env *catch_env = new_env(env,
+ _listX(1, a21),
+ _listX(1, mal_error));
+ //malval_free(mal_error);
+ mal_error = NULL;
+ res = EVAL(a22, catch_env);
return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("macroexpand", a0->val.string) == 0) {
- //g_print("eval apply macroexpand\n");
- MalVal *a1 = _nth(ast, 1);
- return macroexpand(a1, env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp(".", a0->val.string) == 0) {
- //g_print("eval apply .\n");
- MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env);
- return invoke_native(el);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("try*", a0->val.string) == 0) {
- //g_print("eval apply try*\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a1, env);
- if (!mal_error) { return res; }
- MalVal *a20 = _nth(a2, 0);
- if (strcmp("catch*", a20->val.string) == 0) {
- MalVal *a21 = _nth(a2, 1);
- MalVal *a22 = _nth(a2, 2);
- Env *catch_env = new_env(env,
- _listX(1, a21),
- _listX(1, mal_error));
- //malval_free(mal_error);
- mal_error = NULL;
- res = EVAL(a22, catch_env);
- return res;
- } else {
+ } else {
+ return &mal_nil;
+ }
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("do", a0->val.string) == 0) {
+ //g_print("eval apply do\n");
+ eval_ast(_slice(ast, 1, _count(ast)-1), env);
+ ast = _last(ast);
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("if", a0->val.string) == 0) {
+ //g_print("eval apply if\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *cond = EVAL(a1, env);
+ if (!cond || mal_error) return NULL;
+ if (cond->type & (MAL_FALSE|MAL_NIL)) {
+ // eval false slot form
+ ast = _nth(ast, 3);
+ if (!ast) {
return &mal_nil;
}
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("do", a0->val.string) == 0) {
- //g_print("eval apply do\n");
- eval_ast(_slice(ast, 1, _count(ast)-1), env);
- ast = last(ast);
- // Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("if", a0->val.string) == 0) {
- //g_print("eval apply if\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *cond = EVAL(a1, env);
- if (!cond || mal_error) return NULL;
- if (cond->type & (MAL_FALSE|MAL_NIL)) {
- // eval false slot form
- ast = _nth(ast, 3);
- if (!ast) {
- return &mal_nil;
- }
- } else {
- // eval true slot form
- ast = _nth(ast, 2);
- }
+ } else {
+ // eval true slot form
+ ast = _nth(ast, 2);
+ }
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("fn*", a0->val.string) == 0) {
+ //g_print("eval apply fn*\n");
+ MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+ mf->ismacro = FALSE;
+ mf->val.func.evaluator = EVAL;
+ mf->val.func.args = _nth(ast, 1);
+ mf->val.func.body = _nth(ast, 2);
+ mf->val.func.env = env;
+ return mf;
+ } else {
+ //g_print("eval apply\n");
+ MalVal *el = eval_ast(ast, env);
+ if (!el || mal_error) { return NULL; }
+ MalVal *f = _first(el),
+ *args = _rest(el);
+ assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "cannot apply '%s'", _pr_str(f,1));
+ if (f->type & MAL_FUNCTION_MAL) {
+ ast = f->val.func.body;
+ env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("fn*", a0->val.string) == 0) {
- //g_print("eval apply fn*\n");
- MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
- mf->ismacro = FALSE;
- mf->val.func.evaluator = EVAL;
- mf->val.func.args = _nth(ast, 1);
- mf->val.func.body = _nth(ast, 2);
- mf->val.func.env = env;
- return mf;
} else {
- //g_print("eval apply\n");
- MalVal *el = eval_ast(ast, env);
- if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
- assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "cannot invoke '%s'", _pr_str(f,1));
- if (f->type & MAL_FUNCTION_MAL) {
- ast = f->val.func.body;
- env = new_env(f->val.func.env, f->val.func.args, args);
- // Continue loop
- } else {
- return _apply(f, args);
- }
+ return _apply(f, args);
}
}
+
+ } // TCO while loop
}
// print
@@ -283,71 +284,25 @@ MalVal *RE(Env *env, char *prompt, char *str) {
// Setup the initial REPL environment
Env *repl_env;
-char *slurp_raw(char *path) {
- char *data;
- struct stat fst;
- int fd = open(path, O_RDONLY),
- sz;
- if (fd < 0) {
- abort("slurp failed to open '%s'", path);
- }
- if (fstat(fd, &fst) < 0) {
- abort("slurp failed to stat '%s'", path);
- }
- data = malloc(fst.st_size+1);
- sz = read(fd, data, fst.st_size);
- if (sz < fst.st_size) {
- abort("slurp failed to read '%s'", path);
- }
- data[sz] = '\0';
- return data;
-}
-
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
- }
-
- MalVal *readline(MalVal *str) {
- assert_type(str, MAL_STRING, "readline of non-string");
- char * line = _readline(str->val.string);
- if (line) { return malval_new_string(line); }
- else { return &mal_nil; }
- }
- _ref("readline", readline, 1);
-
- MalVal *read_string(MalVal *str) {
- assert_type(str, MAL_STRING, "read_string of non-string");
- return read_str(str->val.string);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
- _ref("read-string", read_string, 1);
-
- MalVal *do_eval(MalVal *ast) {
- return EVAL(ast, repl_env);
- }
- _ref("eval", do_eval, 1);
-
- MalVal *slurp(MalVal *path) {
- assert_type(path, MAL_STRING, "slurp of non-string");
- char *data = slurp_raw(path->val.string);
- if (!data || mal_error) { return NULL; }
- return malval_new_string(data);
- }
- _ref("slurp", slurp, 1);
+ MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); }
+ env_set(repl_env, "eval",
+ malval_new_function((void*(*)(void *))do_eval, 1));
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
- RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
- RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
RE(repl_env, "",
"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
+ RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
+ RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
}
int main(int argc, char *argv[])
@@ -363,21 +318,22 @@ int main(int argc, char *argv[])
if (argc > 1) {
char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
RE(repl_env, "", cmd);
- } else {
- // REPL loop
- for(;;) {
- exp = RE(repl_env, prompt, NULL);
- if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
- return 0;
- }
- output = PRINT(exp);
+ return 0;
+ }
- if (output) {
- g_print("%s\n", output);
- free(output); // Free output string
- }
+ // REPL loop
+ for(;;) {
+ exp = RE(repl_env, prompt, NULL);
+ if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
+ return 0;
+ }
+ output = PRINT(exp);
- //malval_free(exp); // Free evaluated expression
+ if (output) {
+ g_print("%s\n", output);
+ free(output); // Free output string
}
+
+ //malval_free(exp); // Free evaluated expression
}
}
diff --git a/c/types.c b/c/types.c
index 5c06d9d..3f1771b 100644
--- a/c/types.c
+++ b/c/types.c
@@ -124,8 +124,8 @@ MalVal *malval_new_atom(MalVal *val) {
}
-MalVal *malval_new_function(void *(*func)(void *), int arg_cnt, MalVal* metadata) {
- MalVal *mv = malval_new(MAL_FUNCTION_C, metadata);
+MalVal *malval_new_function(void *(*func)(void *), int arg_cnt) {
+ MalVal *mv = malval_new(MAL_FUNCTION_C, NULL);
mv->func_arg_cnt = arg_cnt;
assert(mv->func_arg_cnt <= 20,
"native function restricted to 20 args (%d given)",
@@ -420,13 +420,37 @@ int _sequential_Q(MalVal *seq) {
MalVal *_nth(MalVal *seq, int idx) {
assert_type(seq, MAL_LIST|MAL_VECTOR,
- "nth called with non-sequential");
+ "_nth called with non-sequential");
if (idx >= _count(seq)) {
return &mal_nil;
}
return g_array_index(seq->val.array, MalVal*, idx);
}
+MalVal *_first(MalVal *seq) {
+ assert_type(seq, MAL_LIST|MAL_VECTOR,
+ "_first called with non-sequential");
+ if (_count(seq) == 0) {
+ return &mal_nil;
+ }
+ return g_array_index(seq->val.array, MalVal*, 0);
+}
+
+MalVal *_last(MalVal *seq) {
+ assert_type(seq, MAL_LIST|MAL_VECTOR,
+ "_last called with non-sequential");
+ if (_count(seq) == 0) {
+ return &mal_nil;
+ }
+ return g_array_index(seq->val.array, MalVal*, _count(seq)-1);
+}
+
+
+MalVal *_rest(MalVal *seq) {
+ return _slice(seq, 1, _count(seq));
+}
+
+
MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) {
MalVal *e, *el;
assert_type(lst, MAL_LIST|MAL_VECTOR,
diff --git a/c/types.h b/c/types.h
index d65e4ef..aa6c5e3 100644
--- a/c/types.h
+++ b/c/types.h
@@ -133,8 +133,19 @@ MalVal *malval_new_symbol(char *val);
MalVal *malval_new_list(MalType type, GArray *val);
MalVal *malval_new_hash_map(GHashTable *val);
MalVal *malval_new_atom(MalVal *val);
-MalVal *malval_new_function(void *(*func)(void *), int arg_cnt, MalVal* metadata);
+MalVal *malval_new_function(void *(*func)(void *), int arg_cnt);
+// Numbers
+#define WRAP_INTEGER_OP(name, op) \
+ MalVal *int_ ## name(MalVal *a, MalVal *b) { \
+ return malval_new_integer(a->val.intnum op b->val.intnum); \
+ }
+#define WRAP_INTEGER_CMP_OP(name, op) \
+ MalVal *int_ ## name(MalVal *a, MalVal *b) { \
+ return a->val.intnum op b->val.intnum ? &mal_true : &mal_false; \
+ }
+
+// Collections
MalVal *_listX(int count, ...);
MalVal *_list(MalVal *args);
MalVal *_vector(MalVal *args);
@@ -148,6 +159,9 @@ char *_pr_str(MalVal *args, int print_readably);
MalVal *_slice(MalVal *seq, int start, int end);
MalVal *_nth(MalVal *seq, int idx);
+MalVal *_first(MalVal *seq);
+MalVal *_rest(MalVal *seq);
+MalVal *_last(MalVal *seq);
MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2);
generated by cgit v1.2.3 (git 2.25.1) at 2026-01-11 06:12:38 +0000