aboutsummaryrefslogtreecommitdiff
path: root/c
diff options
context:
space:
mode:
Diffstat (limited to 'c')
-rw-r--r--c/Makefile10
-rw-r--r--c/core.c464
-rw-r--r--c/core.h29
-rw-r--r--c/env.c62
-rw-r--r--c/printer.c140
-rw-r--r--c/printer.h9
-rw-r--r--c/reader.c26
-rw-r--r--c/step2_eval.c1
-rw-r--r--c/step3_env.c1
-rw-r--r--c/step4_if_fn_do.c9
-rw-r--r--c/step5_tco.c9
-rw-r--r--c/step6_file.c9
-rw-r--r--c/step7_quote.c25
-rw-r--r--c/step8_macros.c25
-rw-r--r--c/step9_interop.c25
-rw-r--r--c/stepA_more.c31
-rw-r--r--c/types.c753
-rw-r--r--c/types.h74
18 files changed, 883 insertions, 819 deletions
diff --git a/c/Makefile b/c/Makefile
index 397bcbf..fab4447 100644
--- a/c/Makefile
+++ b/c/Makefile
@@ -6,8 +6,10 @@ LDFLAGS += -g
TESTS =
-SOURCES = types.h types.c readline.h readline.c reader.h reader.c \
- interop.h interop.c stepA_more.c
+SOURCES = readline.h readline.c types.h types.c \
+ reader.h reader.c printer.h printer.c \
+ env.c core.h core.c interop.h interop.c \
+ stepA_more.c
#####################
@@ -16,8 +18,8 @@ SRCS = step0_repl.c step1_read_print.c step2_eval.c step3_env.c \
step8_macros.c step9_interop.c stepA_more.c
OBJS = $(SRCS:%.c=%.o)
BINS = $(OBJS:%.o=%)
-OTHER_OBJS = types.o readline.o reader.o interop.o
-OTHER_HDRS = types.h readline.h reader.h interop.h
+OTHER_OBJS = types.o readline.o reader.o printer.o env.o core.o interop.o
+OTHER_HDRS = types.h readline.h reader.h printer.h core.h interop.h
GLIB_CFLAGS ?= $(shell pkg-config --cflags glib-2.0)
GLIB_LDFLAGS ?= $(shell pkg-config --libs glib-2.0)
diff --git a/c/core.c b/c/core.c
new file mode 100644
index 0000000..abdf755
--- /dev/null
+++ b/c/core.c
@@ -0,0 +1,464 @@
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "types.h"
+#include "core.h"
+#include "printer.h"
+
+// Errors/Exceptions
+void throw(MalVal *obj) {
+ mal_error = obj;
+}
+
+
+// General functions
+
+MalVal *equal_Q(MalVal *a, MalVal *b) {
+ if (_equal_Q(a, b)) { return &mal_true; }
+ else { return &mal_false; }
+}
+
+
+// Scalar functions
+
+MalVal *nil_Q(MalVal *seq) { return seq->type & MAL_NIL ? &mal_true : &mal_false; }
+MalVal *true_Q(MalVal *seq) { return seq->type & MAL_TRUE ? &mal_true : &mal_false; }
+MalVal *false_Q(MalVal *seq) { return seq->type & MAL_FALSE ? &mal_true : &mal_false; }
+
+
+// Symbol functions
+
+MalVal *symbol(MalVal *args) {
+ assert_type(args, MAL_STRING,
+ "symbol called with non-string value");
+ args->type = MAL_SYMBOL; // change string to symbol
+ return args;
+}
+
+MalVal *symbol_Q(MalVal *seq) { return seq->type & MAL_SYMBOL ? &mal_true : &mal_false; }
+
+
+// String functions
+
+// Return a string representation of a MalVal sequence (in a format that can
+// be read by the reader). Returned string must be freed by caller.
+MalVal *pr_str(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "pr_str called with non-sequential args");
+ return malval_new_string(_pr_str_args(args, " ", 1));
+}
+
+// Return a string representation of a MalVal sequence with every item
+// concatenated together. Returned string must be freed by caller.
+MalVal *str(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "str called with non-sequential args");
+ return malval_new_string(_pr_str_args(args, "", 0));
+}
+
+// Print a string representation of a MalVal sequence (in a format that can
+// be read by the reader) followed by a newline. Returns nil.
+MalVal *prn(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "prn called with non-sequential args");
+ char *repr = _pr_str_args(args, " ", 1);
+ g_print("%s\n", repr);
+ free(repr);
+ return &mal_nil;
+}
+
+// Print a string representation of a MalVal sequence (for human consumption)
+// followed by a newline. Returns nil.
+MalVal *println(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "println called with non-sequential args");
+ char *repr = _pr_str_args(args, " ", 0);
+ g_print("%s\n", repr);
+ free(repr);
+ return &mal_nil;
+}
+
+
+// Number functions
+
+#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; \
+ }
+WRAP_INTEGER_OP(plus,+)
+WRAP_INTEGER_OP(minus,-)
+WRAP_INTEGER_OP(multiply,*)
+WRAP_INTEGER_OP(divide,/)
+WRAP_INTEGER_CMP_OP(gt,>)
+WRAP_INTEGER_CMP_OP(gte,>=)
+WRAP_INTEGER_CMP_OP(lt,<)
+WRAP_INTEGER_CMP_OP(lte,<=)
+
+
+// List functions
+
+MalVal *list(MalVal *args) { return _list(args); }
+MalVal *list_Q(MalVal *seq) { return _list_Q(seq) ? &mal_true : &mal_false; }
+
+
+// Vector functions
+
+MalVal *vector(MalVal *args) { return _vector(args); }
+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) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "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);
+ MalVal *hm = malval_new_hash_map(htable);
+ return _assoc_BANG(hm, rest(args));
+}
+
+MalVal *dissoc(MalVal* args) {
+ GHashTable *htable = g_hash_table_copy(first(args)->val.hash_table);
+ MalVal *hm = malval_new_hash_map(htable);
+ return _dissoc_BANG(hm, rest(args));
+}
+
+MalVal *keys(MalVal *obj) {
+ assert_type(obj, MAL_HASH_MAP,
+ "keys called on non-hash-map");
+
+ GHashTableIter iter;
+ gpointer key, value;
+ MalVal *seq = malval_new_list(MAL_LIST,
+ g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
+ _count(obj)));
+ g_hash_table_iter_init (&iter, obj->val.hash_table);
+ while (g_hash_table_iter_next (&iter, &key, &value)) {
+ MalVal *kname = malval_new_string((char *)key);
+ g_array_append_val(seq->val.array, kname);
+ }
+ return seq;
+}
+
+MalVal *vals(MalVal *obj) {
+ assert_type(obj, MAL_HASH_MAP,
+ "vals called on non-hash-map");
+
+ GHashTableIter iter;
+ gpointer key, value;
+ MalVal *seq = malval_new_list(MAL_LIST,
+ g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
+ _count(obj)));
+ g_hash_table_iter_init (&iter, obj->val.hash_table);
+ while (g_hash_table_iter_next (&iter, &key, &value)) {
+ g_array_append_val(seq->val.array, value);
+ }
+ return seq;
+}
+
+
+// hash map and vector functions
+MalVal *get(MalVal *obj, MalVal *key) {
+ MalVal *val;
+ switch (obj->type) {
+ case MAL_VECTOR:
+ return _nth(obj, key->val.intnum);
+ case MAL_HASH_MAP:
+ if (g_hash_table_lookup_extended(obj->val.hash_table,
+ key->val.string,
+ NULL, (gpointer*)&val)) {
+ return val;
+ } else {
+ return &mal_nil;
+ }
+ default:
+ abort("get called on unsupported type %d", obj->type);
+ }
+}
+
+MalVal *contains_Q(MalVal *obj, MalVal *key) {
+ switch (obj->type) {
+ case MAL_VECTOR:
+ if (key->val.intnum < obj->val.array->len) {
+ return &mal_true;
+ } else {
+ return &mal_false;
+ }
+ case MAL_HASH_MAP:
+ if (g_hash_table_contains(obj->val.hash_table, key->val.string)) {
+ return &mal_true;
+ } else {
+ return &mal_false;
+ }
+ default:
+ abort("contains? called on unsupported type %d", obj->type);
+ }
+}
+
+
+// Sequence functions
+
+MalVal *sequential_Q(MalVal *seq) {
+ return _sequential_Q(seq) ? &mal_true : &mal_false;
+}
+
+MalVal *cons(MalVal *x, MalVal *seq) {
+ assert_type(seq, MAL_LIST|MAL_VECTOR,
+ "second argument to cons is non-sequential");
+ int i, len = _count(seq);
+ GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
+ len+1);
+ g_array_append_val(new_arr, x);
+ for (i=0; i<len; i++) {
+ g_array_append_val(new_arr, g_array_index(seq->val.array, MalVal*, i));
+ }
+ return malval_new_list(MAL_LIST, new_arr);
+}
+
+MalVal *concat(MalVal *args) {
+ MalVal *arg, *e, *lst;
+ int i, j, arg_cnt = _count(args);
+ lst = malval_new_list(MAL_LIST,
+ g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), arg_cnt));
+ for (i=0; i<arg_cnt; i++) {
+ arg = g_array_index(args->val.array, MalVal*, i);
+ assert_type(arg, MAL_LIST|MAL_VECTOR,
+ "concat called with non-sequential");
+ for (j=0; j<_count(arg); j++) {
+ e = g_array_index(arg->val.array, MalVal*, j);
+ g_array_append_val(lst->val.array, e);
+ }
+ }
+ return lst;
+}
+
+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");
+ return (seq->val.array->len == 0) ? &mal_true : &mal_false;
+}
+
+MalVal *count(MalVal *seq) {
+ return malval_new_integer(_count(seq));
+}
+
+MalVal *sconj(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "conj called with non-sequential");
+ MalVal *src_lst = _nth(args, 0);
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "first argument to conj is non-sequential");
+ int i, len = _count(src_lst) + _count(args) - 1;
+ GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
+ len);
+ // Copy in src_lst
+ for (i=0; i<_count(src_lst); i++) {
+ g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i));
+ }
+ // Conj extra args
+ for (i=1; i<_count(args); i++) {
+ if (src_lst->type & MAL_LIST) {
+ g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i));
+ } else {
+ g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i));
+ }
+ }
+ 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);
+ assert_type(last_arg, MAL_LIST|MAL_VECTOR,
+ "last argument to apply is non-sequential");
+ int i, len = _count(args) - 2 + _count(last_arg);
+ GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
+ len);
+ // Initial arguments
+ for (i=1; i<_count(args)-1; i++) {
+ g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i));
+ }
+ // Add arguments from last_arg
+ for (i=0; i<_count(last_arg); i++) {
+ g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i));
+ }
+ return _apply(f, malval_new_list(MAL_LIST, new_arr));
+}
+
+MalVal *map(MalVal *mvf, MalVal *lst) {
+ MalVal *res, *el;
+ assert_type(mvf, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "map called with non-function");
+ assert_type(lst, MAL_LIST|MAL_VECTOR,
+ "map called with non-sequential");
+ int i, len = _count(lst);
+ el = malval_new_list(MAL_LIST,
+ g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len));
+ for (i=0; i<len; i++) {
+ // TODO: this is replicating some of apply functionality
+ if (mvf->type & MAL_FUNCTION_MAL) {
+ Env *fn_env = new_env(mvf->val.func.env,
+ mvf->val.func.args,
+ _slice(lst, i, i+1));
+ res = mvf->val.func.evaluator(mvf->val.func.body, fn_env);
+ } else {
+ res = mvf->val.f1(g_array_index(lst->val.array, MalVal*, i));
+ }
+ if (!res || mal_error) return NULL;
+ g_array_append_val(el->val.array, res);
+ }
+ return el;
+}
+
+
+// Metadata functions
+
+MalVal *with_meta(MalVal *obj, MalVal *meta) {
+ MalVal *new_obj = malval_new(obj->type, meta);
+ new_obj->val = obj->val;
+ return new_obj;
+}
+
+MalVal *meta(MalVal *obj) {
+ assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_HASH_MAP|MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "attempt to get metadata from non-collection type");
+ if (obj->metadata == NULL) {
+ return &mal_nil;
+ } else {
+ return obj->metadata;
+ }
+}
+
+
+// Atoms
+
+MalVal *atom(MalVal *val) {
+ return malval_new_atom(val);
+}
+
+MalVal *atom_Q(MalVal *exp) { return _atom_Q(exp) ? &mal_true : &mal_false; }
+
+MalVal *deref(MalVal *atm) {
+ assert_type(atm, MAL_ATOM,
+ "deref called on non-atom");
+ return atm->val.atom_val;
+}
+
+MalVal *reset_BANG(MalVal *atm, MalVal *val) {
+ assert_type(atm, MAL_ATOM,
+ "reset! called with non-atom");
+ atm->val.atom_val = val;
+ return val;
+}
+
+MalVal *swap_BANG(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "swap! called with invalid arguments");
+ assert(_count(args) >= 2,
+ "swap! called with %d args, needs at least 2", _count(args));
+ MalVal *atm = _nth(args, 0),
+ *f = _nth(args, 1),
+ *sargs = _slice(args, 2, _count(args)),
+ *fargs = cons(atm->val.atom_val, sargs),
+ *new_val = _apply(f, fargs);
+ if (mal_error) { return NULL; }
+ atm->val.atom_val = new_val;
+ return new_val;
+}
+
+
+
+core_ns_entry core_ns[50] = {
+ {"=", (void*(*)(void*))equal_Q, 2},
+ {"throw", (void*(*)(void*))throw, 1},
+ {"nil?", (void*(*)(void*))nil_Q, 1},
+ {"true?", (void*(*)(void*))true_Q, 1},
+ {"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},
+ {"<", (void*(*)(void*))int_lt, 2},
+ {"<=", (void*(*)(void*))int_lte, 2},
+ {">", (void*(*)(void*))int_gt, 2},
+ {">=", (void*(*)(void*))int_gte, 2},
+ {"+", (void*(*)(void*))int_plus, 2},
+ {"-", (void*(*)(void*))int_minus, 2},
+ {"*", (void*(*)(void*))int_multiply, 2},
+ {"/", (void*(*)(void*))int_divide, 2},
+
+ {"list", (void*(*)(void*))list, -1},
+ {"list?", (void*(*)(void*))list_Q, 1},
+ {"vector", (void*(*)(void*))vector, -1},
+ {"vector?", (void*(*)(void*))vector_Q, 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},
+ {"get", (void*(*)(void*))get, 2},
+ {"contains?", (void*(*)(void*))contains_Q, 2},
+ {"keys", (void*(*)(void*))keys, 1},
+ {"vals", (void*(*)(void*))vals, 1},
+
+ {"sequential?", (void*(*)(void*))sequential_Q, 1},
+ {"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},
+ {"empty?", (void*(*)(void*))empty_Q, 1},
+ {"count", (void*(*)(void*))count, 1},
+ {"conj", (void*(*)(void*))sconj, -1},
+ {"apply", (void*(*)(void*))apply, -1},
+ {"map", (void*(*)(void*))map, 2},
+
+ {"with-meta", (void*(*)(void*))with_meta, 2},
+ {"meta", (void*(*)(void*))meta, 1},
+ {"atom", (void*(*)(void*))atom, 1},
+ {"atom?", (void*(*)(void*))atom_Q, 1},
+ {"deref", (void*(*)(void*))deref, 1},
+ {"reset!", (void*(*)(void*))reset_BANG, 2},
+ {"swap!", (void*(*)(void*))swap_BANG, -1},
+ };
diff --git a/c/core.h b/c/core.h
new file mode 100644
index 0000000..6668c53
--- /dev/null
+++ b/c/core.h
@@ -0,0 +1,29 @@
+#ifndef __MAL_CORE__
+#define __MAL_CORE__
+
+#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;
+ void *(*func)(void*);
+ int arg_cnt;
+} core_ns_entry;
+
+extern core_ns_entry core_ns[50];
+
+#endif
diff --git a/c/env.c b/c/env.c
new file mode 100644
index 0000000..d4b8f32
--- /dev/null
+++ b/c/env.c
@@ -0,0 +1,62 @@
+/*
+#include <stdarg.h>
+#include <stdio.h>
+#include <string.h>
+*/
+#include <stdlib.h>
+#include "types.h"
+
+// Env
+
+Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) {
+ Env *e = malloc(sizeof(Env));
+ e->table = g_hash_table_new(g_str_hash, g_str_equal);
+ e->outer = outer;
+
+ if (binds && exprs) {
+ assert_type(binds, MAL_LIST|MAL_VECTOR,
+ "new_env called with non-sequential bindings");
+ assert_type(exprs, MAL_LIST|MAL_VECTOR,
+ "new_env called with non-sequential expressions");
+ int binds_len = _count(binds),
+ exprs_len = _count(exprs),
+ varargs = 0, i;
+ for (i=0; i<binds_len; i++) {
+ if (i > exprs_len) { break; }
+ if (_nth(binds, i)->val.string[0] == '&') {
+ varargs = 1;
+ env_set(e, _nth(binds, i+1)->val.string, _slice(exprs, i, _count(exprs)));
+ break;
+ } else {
+ env_set(e, _nth(binds, i)->val.string, _nth(exprs, i));
+ }
+ }
+ assert(varargs || (binds_len == exprs_len),
+ "Arity mismatch: %d formal params vs %d actual params",
+ binds_len, exprs_len);
+
+ }
+ return e;
+}
+
+Env *env_find(Env *env, char *key) {
+ void *val = g_hash_table_lookup(env->table, key);
+ if (val) {
+ return env;
+ } else if (env->outer) {
+ return env_find(env->outer, key);
+ } else {
+ return NULL;
+ }
+}
+
+MalVal *env_get(Env *env, char *key) {
+ Env *e = env_find(env, key);
+ assert(e, "'%s' not found", key);
+ return g_hash_table_lookup(e->table, key);
+}
+
+Env *env_set(Env *env, char *key, MalVal *val) {
+ g_hash_table_insert(env->table, key, val);
+ return env;
+}
diff --git a/c/printer.c b/c/printer.c
new file mode 100644
index 0000000..0669cf6
--- /dev/null
+++ b/c/printer.c
@@ -0,0 +1,140 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include "types.h"
+#include "printer.h"
+
+char *_pr_str_hash_map(MalVal *obj, int print_readably) {
+ int start = 1;
+ char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL;
+ GHashTableIter iter;
+ gpointer key, value;
+
+ repr = g_strdup_printf("{");
+
+ g_hash_table_iter_init (&iter, obj->val.hash_table);
+ while (g_hash_table_iter_next (&iter, &key, &value)) {
+ //g_print ("%s/%p ", (const char *) key, (void *) value);
+
+ repr_tmp1 = _pr_str((MalVal*)value, print_readably);
+ if (start) {
+ start = 0;
+ repr = g_strdup_printf("{\"%s\" %s", (char *)key, repr_tmp1);
+ } else {
+ repr_tmp2 = repr;
+ repr = g_strdup_printf("%s \"%s\" %s", repr_tmp2, (char *)key, repr_tmp1);
+ free(repr_tmp2);
+ }
+ free(repr_tmp1);
+ }
+ repr_tmp2 = repr;
+ repr = g_strdup_printf("%s}", repr_tmp2);
+ free(repr_tmp2);
+ return repr;
+}
+
+char *_pr_str_list(MalVal *obj, int print_readably, char start, char end) {
+ int i;
+ char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL;
+ repr = g_strdup_printf("%c", start);
+ for (i=0; i<_count(obj); i++) {
+ repr_tmp1 = _pr_str(g_array_index(obj->val.array, MalVal*, i),
+ print_readably);
+ if (i == 0) {
+ repr = g_strdup_printf("%c%s", start, repr_tmp1);
+ } else {
+ repr_tmp2 = repr;
+ repr = g_strdup_printf("%s %s", repr_tmp2, repr_tmp1);
+ free(repr_tmp2);
+ }
+ free(repr_tmp1);
+ }
+ repr_tmp2 = repr;
+ repr = g_strdup_printf("%s%c", repr_tmp2, end);
+ free(repr_tmp2);
+ return repr;
+}
+
+// Return a string representation of the MalVal object. Returned string must
+// be freed by caller.
+char *_pr_str(MalVal *obj, int print_readably) {
+ char *repr = NULL;
+ if (obj == NULL) { return NULL; }
+ switch (obj->type) {
+ case MAL_NIL:
+ repr = g_strdup_printf("nil");
+ break;
+ case MAL_TRUE:
+ repr = g_strdup_printf("true");
+ break;
+ case MAL_FALSE:
+ repr = g_strdup_printf("false");
+ break;
+ case MAL_STRING:
+ if (print_readably) {
+ char *repr_tmp = g_strescape(obj->val.string, "");
+ repr = g_strdup_printf("\"%s\"", repr_tmp);
+ free(repr_tmp);
+ } else {
+ repr = g_strdup_printf("%s", obj->val.string);
+ }
+ break;
+ case MAL_SYMBOL:
+ repr = g_strdup_printf("%s", obj->val.string);
+ break;
+ case MAL_INTEGER:
+ repr = g_strdup_printf("%" G_GINT64_FORMAT, obj->val.intnum);
+ break;
+ case MAL_FLOAT:
+ repr = g_strdup_printf("%f", obj->val.floatnum);
+ break;
+ case MAL_HASH_MAP:
+ repr = _pr_str_hash_map(obj, print_readably);
+ break;
+ case MAL_LIST:
+ repr = _pr_str_list(obj, print_readably, '(', ')');
+ break;
+ case MAL_VECTOR:
+ repr = _pr_str_list(obj, print_readably, '[', ']');
+ break;
+ case MAL_ATOM:
+ repr = g_strdup_printf("(atom %s)",
+ _pr_str(obj->val.atom_val, print_readably));
+ break;
+ case MAL_FUNCTION_C:
+ repr = g_strdup_printf("#<function@%p>", obj->val.f0);
+ break;
+ case MAL_FUNCTION_MAL:
+ repr = g_strdup_printf("#<Function: (fn* %s %s)>",
+ _pr_str(obj->val.func.args, print_readably),
+ _pr_str(obj->val.func.body, print_readably));
+ break;
+ default:
+ printf("pr_str unknown type %d\n", obj->type);
+ repr = g_strdup_printf("<unknown>");
+ }
+ return repr;
+}
+
+// Return a string representation of the MalVal arguments. Returned string must
+// be freed by caller.
+char *_pr_str_args(MalVal *args, char *sep, int print_readably) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "_pr_str called with non-sequential args");
+ int i;
+ char *repr = g_strdup_printf(""),
+ *repr2 = NULL;
+ for (i=0; i<_count(args); i++) {
+ MalVal *obj = g_array_index(args->val.array, MalVal*, i);
+ if (i != 0) {
+ repr2 = repr;
+ repr = g_strdup_printf("%s%s", repr2, sep);
+ free(repr2);
+ }
+ repr2 = repr;
+ repr = g_strdup_printf("%s%s",
+ repr2, _pr_str(obj, print_readably));
+ free(repr2);
+ }
+ return repr;
+}
+
diff --git a/c/printer.h b/c/printer.h
new file mode 100644
index 0000000..b3f389a
--- /dev/null
+++ b/c/printer.h
@@ -0,0 +1,9 @@
+#ifndef __MAL_PRINTER__
+#define __MAL_PRINTER__
+
+#include "types.h"
+
+char *_pr_str_args(MalVal *args, char *sep, int print_readably);
+char *_pr_str(MalVal *obj, int print_readably);
+
+#endif
diff --git a/c/reader.c b/c/reader.c
index 044bb84..dbb7335 100644
--- a/c/reader.c
+++ b/c/reader.c
@@ -181,7 +181,7 @@ MalVal *read_list(Reader *reader, MalType type, char start, char end) {
MalVal *read_hash_map(Reader *reader) {
MalVal *lst = read_list(reader, MAL_LIST, '{', '}');
- MalVal *hm = hash_map(lst);
+ MalVal *hm = _hash_map(lst);
malval_free(lst);
return hm;
}
@@ -207,34 +207,34 @@ MalVal *read_form(Reader *reader) {
break;
case '\'':
reader_next(reader);
- form = _list(2, malval_new_symbol("quote"),
- read_form(reader));
+ form = _listX(2, malval_new_symbol("quote"),
+ read_form(reader));
break;
case '`':
reader_next(reader);
- form = _list(2, malval_new_symbol("quasiquote"),
- read_form(reader));
+ form = _listX(2, malval_new_symbol("quasiquote"),
+ read_form(reader));
break;
case '~':
reader_next(reader);
if (token[1] == '@') {
- form = _list(2, malval_new_symbol("splice-unquote"),
- read_form(reader));
+ form = _listX(2, malval_new_symbol("splice-unquote"),
+ read_form(reader));
} else {
- form = _list(2, malval_new_symbol("unquote"),
- read_form(reader));
+ form = _listX(2, malval_new_symbol("unquote"),
+ read_form(reader));
};
break;
case '^':
reader_next(reader);
MalVal *meta = read_form(reader);
- form = _list(3, malval_new_symbol("with-meta"),
- read_form(reader), meta);
+ form = _listX(3, malval_new_symbol("with-meta"),
+ read_form(reader), meta);
break;
case '@':
reader_next(reader);
- form = _list(2, malval_new_symbol("deref"),
- read_form(reader));
+ form = _listX(2, malval_new_symbol("deref"),
+ read_form(reader));
break;
diff --git a/c/step2_eval.c b/c/step2_eval.c
index 509e795..85746f8 100644
--- a/c/step2_eval.c
+++ b/c/step2_eval.c
@@ -4,6 +4,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
// Declarations
MalVal *EVAL(MalVal *ast, GHashTable *env);
diff --git a/c/step3_env.c b/c/step3_env.c
index bc645b8..4abf4d6 100644
--- a/c/step3_env.c
+++ b/c/step3_env.c
@@ -4,6 +4,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
// Declarations
MalVal *EVAL(MalVal *ast, Env *env);
diff --git a/c/step4_if_fn_do.c b/c/step4_if_fn_do.c
index a96641e..3662816 100644
--- a/c/step4_if_fn_do.c
+++ b/c/step4_if_fn_do.c
@@ -4,6 +4,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
// Declarations
MalVal *EVAL(MalVal *ast, Env *env);
@@ -139,7 +140,7 @@ MalVal *EVAL(MalVal *ast, Env *env) {
*args = rest(el);
assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
"cannot apply '%s'", _pr_str(f,1));
- return apply(f, args);
+ return _apply(f, args);
}
}
@@ -179,9 +180,9 @@ void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
int i;
- for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
- _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+ 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);
}
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
diff --git a/c/step5_tco.c b/c/step5_tco.c
index dc0b28e..99d6826 100644
--- a/c/step5_tco.c
+++ b/c/step5_tco.c
@@ -4,6 +4,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
// Declarations
MalVal *EVAL(MalVal *ast, Env *env);
@@ -144,7 +145,7 @@ MalVal *EVAL(MalVal *ast, Env *env) {
env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
} else {
- return apply(f, args);
+ return _apply(f, args);
}
}
}
@@ -186,9 +187,9 @@ void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
int i;
- for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
- _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+ 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);
}
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
diff --git a/c/step6_file.c b/c/step6_file.c
index bfd81fd..acde758 100644
--- a/c/step6_file.c
+++ b/c/step6_file.c
@@ -6,6 +6,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
#include "interop.h"
// Declarations
@@ -147,7 +148,7 @@ MalVal *EVAL(MalVal *ast, Env *env) {
env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
} else {
- return apply(f, args);
+ return _apply(f, args);
}
}
}
@@ -209,9 +210,9 @@ void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
int i;
- for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
- _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+ 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) {
diff --git a/c/step7_quote.c b/c/step7_quote.c
index 5e6de17..7da47ee 100644
--- a/c/step7_quote.c
+++ b/c/step7_quote.c
@@ -6,6 +6,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
#include "interop.h"
// Declarations
@@ -36,7 +37,7 @@ int is_pair(MalVal *x) {
MalVal *quasiquote(MalVal *ast) {
if (!is_pair(ast)) {
- return _list(2, malval_new_symbol("quote"), ast);
+ return _listX(2, malval_new_symbol("quote"), ast);
} else {
MalVal *a0 = _nth(ast, 0);
if ((a0->type & MAL_SYMBOL) &&
@@ -46,14 +47,14 @@ MalVal *quasiquote(MalVal *ast) {
MalVal *a00 = _nth(a0, 0);
if ((a00->type & MAL_SYMBOL) &&
strcmp("splice-unquote", a00->val.string) == 0) {
- return _list(3, malval_new_symbol("concat"),
- _nth(a0, 1),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("concat"),
+ _nth(a0, 1),
+ quasiquote(rest(ast)));
}
}
- return _list(3, malval_new_symbol("cons"),
- quasiquote(a0),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("cons"),
+ quasiquote(a0),
+ quasiquote(rest(ast)));
}
}
@@ -91,8 +92,8 @@ 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;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
if (ast->type != MAL_LIST) {
return eval_ast(ast, env);
}
@@ -183,7 +184,7 @@ MalVal *EVAL(MalVal *ast, Env *env) {
env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
} else {
- return apply(f, args);
+ return _apply(f, args);
}
}
}
@@ -245,9 +246,9 @@ void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
int i;
- for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
- _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+ 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) {
diff --git a/c/step8_macros.c b/c/step8_macros.c
index 97da0ec..eb715b1 100644
--- a/c/step8_macros.c
+++ b/c/step8_macros.c
@@ -6,6 +6,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
#include "interop.h"
// Declarations
@@ -37,7 +38,7 @@ int is_pair(MalVal *x) {
MalVal *quasiquote(MalVal *ast) {
if (!is_pair(ast)) {
- return _list(2, malval_new_symbol("quote"), ast);
+ return _listX(2, malval_new_symbol("quote"), ast);
} else {
MalVal *a0 = _nth(ast, 0);
if ((a0->type & MAL_SYMBOL) &&
@@ -47,14 +48,14 @@ MalVal *quasiquote(MalVal *ast) {
MalVal *a00 = _nth(a0, 0);
if ((a00->type & MAL_SYMBOL) &&
strcmp("splice-unquote", a00->val.string) == 0) {
- return _list(3, malval_new_symbol("concat"),
- _nth(a0, 1),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("concat"),
+ _nth(a0, 1),
+ quasiquote(rest(ast)));
}
}
- return _list(3, malval_new_symbol("cons"),
- quasiquote(a0),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("cons"),
+ quasiquote(a0),
+ quasiquote(rest(ast)));
}
}
@@ -72,7 +73,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;
}
@@ -222,7 +223,7 @@ MalVal *EVAL(MalVal *ast, Env *env) {
env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
} else {
- return apply(f, args);
+ return _apply(f, args);
}
}
}
@@ -284,9 +285,9 @@ void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
int i;
- for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
- _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+ 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) {
diff --git a/c/step9_interop.c b/c/step9_interop.c
index 9c25b40..dcd1526 100644
--- a/c/step9_interop.c
+++ b/c/step9_interop.c
@@ -6,6 +6,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
#include "interop.h"
// Declarations
@@ -37,7 +38,7 @@ int is_pair(MalVal *x) {
MalVal *quasiquote(MalVal *ast) {
if (!is_pair(ast)) {
- return _list(2, malval_new_symbol("quote"), ast);
+ return _listX(2, malval_new_symbol("quote"), ast);
} else {
MalVal *a0 = _nth(ast, 0);
if ((a0->type & MAL_SYMBOL) &&
@@ -47,14 +48,14 @@ MalVal *quasiquote(MalVal *ast) {
MalVal *a00 = _nth(a0, 0);
if ((a00->type & MAL_SYMBOL) &&
strcmp("splice-unquote", a00->val.string) == 0) {
- return _list(3, malval_new_symbol("concat"),
- _nth(a0, 1),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("concat"),
+ _nth(a0, 1),
+ quasiquote(rest(ast)));
}
}
- return _list(3, malval_new_symbol("cons"),
- quasiquote(a0),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("cons"),
+ quasiquote(a0),
+ quasiquote(rest(ast)));
}
}
@@ -72,7 +73,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;
}
@@ -227,7 +228,7 @@ MalVal *EVAL(MalVal *ast, Env *env) {
env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
} else {
- return apply(f, args);
+ return _apply(f, args);
}
}
}
@@ -289,9 +290,9 @@ void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
int i;
- for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
- _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+ 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) {
diff --git a/c/stepA_more.c b/c/stepA_more.c
index f5a53ca..4e4152c 100644
--- a/c/stepA_more.c
+++ b/c/stepA_more.c
@@ -6,6 +6,7 @@
#include "types.h"
#include "readline.h"
#include "reader.h"
+#include "core.h"
#include "interop.h"
// Declarations
@@ -37,7 +38,7 @@ int is_pair(MalVal *x) {
MalVal *quasiquote(MalVal *ast) {
if (!is_pair(ast)) {
- return _list(2, malval_new_symbol("quote"), ast);
+ return _listX(2, malval_new_symbol("quote"), ast);
} else {
MalVal *a0 = _nth(ast, 0);
if ((a0->type & MAL_SYMBOL) &&
@@ -47,14 +48,14 @@ MalVal *quasiquote(MalVal *ast) {
MalVal *a00 = _nth(a0, 0);
if ((a00->type & MAL_SYMBOL) &&
strcmp("splice-unquote", a00->val.string) == 0) {
- return _list(3, malval_new_symbol("concat"),
- _nth(a0, 1),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("concat"),
+ _nth(a0, 1),
+ quasiquote(rest(ast)));
}
}
- return _list(3, malval_new_symbol("cons"),
- quasiquote(a0),
- quasiquote(rest(ast)));
+ return _listX(3, malval_new_symbol("cons"),
+ quasiquote(a0),
+ quasiquote(rest(ast)));
}
}
@@ -72,7 +73,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;
}
@@ -193,8 +194,8 @@ MalVal *EVAL(MalVal *ast, Env *env) {
MalVal *a21 = _nth(a2, 1);
MalVal *a22 = _nth(a2, 2);
Env *catch_env = new_env(env,
- _list(1, a21),
- _list(1, mal_error));
+ _listX(1, a21),
+ _listX(1, mal_error));
//malval_free(mal_error);
mal_error = NULL;
res = EVAL(a22, catch_env);
@@ -248,12 +249,12 @@ MalVal *EVAL(MalVal *ast, Env *env) {
env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
} else {
- return apply(f, args);
+ return _apply(f, args);
}
}
}
}
-
+
// print
char *PRINT(MalVal *exp) {
if (mal_error) {
@@ -310,9 +311,9 @@ void init_repl_env() {
repl_env = new_env(NULL, NULL, NULL);
int i;
- for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
- _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+ 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) {
diff --git a/c/types.c b/c/types.c
index a6bfbf6..5c06d9d 100644
--- a/c/types.c
+++ b/c/types.c
@@ -3,11 +3,17 @@
#include <stdlib.h>
#include <string.h>
#include "types.h"
+#include "printer.h"
-// State
-MalVal *mal_error = NULL;
+// Errors/Exceptions
+MalVal *mal_error = NULL; // WARNGIN: global state
+void _error(const char *fmt, ...) {
+ va_list args;
+ va_start(args, fmt);
+ mal_error = malval_new_string(g_strdup_vprintf(fmt, args));
+}
// Constant atomic values
@@ -16,10 +22,6 @@ MalVal mal_true = {MAL_TRUE, NULL, {0}, 0};
MalVal mal_false = {MAL_FALSE, NULL, {0}, 0};
-// Pre-declarations
-
-MalVal *cons(MalVal *x, MalVal *seq);
-
// General Functions
// Print a hash table
@@ -103,18 +105,18 @@ MalVal *malval_new_symbol(char *val) {
return mv;
}
-MalVal *malval_new_hash_map(GHashTable *val) {
- MalVal *mv = malval_new(MAL_HASH_MAP, NULL);
- mv->val.hash_table = val;
- return mv;
-}
-
MalVal *malval_new_list(MalType type, GArray *val) {
MalVal *mv = malval_new(type, NULL);
mv->val.array = val;
return mv;
}
+MalVal *malval_new_hash_map(GHashTable *val) {
+ MalVal *mv = malval_new(MAL_HASH_MAP, NULL);
+ mv->val.hash_table = val;
+ return mv;
+}
+
MalVal *malval_new_atom(MalVal *val) {
MalVal *mv = malval_new(MAL_ATOM, NULL);
mv->val.atom_val = val;
@@ -186,7 +188,7 @@ MalVal *malval_new_function(void *(*func)(void *), int arg_cnt, MalVal* metadata
return mv;
}
-MalVal *apply(MalVal *f, MalVal *args) {
+MalVal *_apply(MalVal *f, MalVal *args) {
MalVal *res;
assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
"Cannot invoke %s", _pr_str(f,1));
@@ -259,196 +261,6 @@ MalVal *apply(MalVal *f, MalVal *args) {
}
-char *_pr_str_hash_map(MalVal *obj, int print_readably) {
- int start = 1;
- char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL;
- GHashTableIter iter;
- gpointer key, value;
-
- repr = g_strdup_printf("{");
-
- g_hash_table_iter_init (&iter, obj->val.hash_table);
- while (g_hash_table_iter_next (&iter, &key, &value)) {
- //g_print ("%s/%p ", (const char *) key, (void *) value);
-
- repr_tmp1 = _pr_str((MalVal*)value, print_readably);
- if (start) {
- start = 0;
- repr = g_strdup_printf("{\"%s\" %s", (char *)key, repr_tmp1);
- } else {
- repr_tmp2 = repr;
- repr = g_strdup_printf("%s \"%s\" %s", repr_tmp2, (char *)key, repr_tmp1);
- free(repr_tmp2);
- }
- free(repr_tmp1);
- }
- repr_tmp2 = repr;
- repr = g_strdup_printf("%s}", repr_tmp2);
- free(repr_tmp2);
- return repr;
-}
-
-char *_pr_str_list(MalVal *obj, int print_readably, char start, char end) {
- int i;
- char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL;
- repr = g_strdup_printf("%c", start);
- for (i=0; i<_count(obj); i++) {
- repr_tmp1 = _pr_str(g_array_index(obj->val.array, MalVal*, i),
- print_readably);
- if (i == 0) {
- repr = g_strdup_printf("%c%s", start, repr_tmp1);
- } else {
- repr_tmp2 = repr;
- repr = g_strdup_printf("%s %s", repr_tmp2, repr_tmp1);
- free(repr_tmp2);
- }
- free(repr_tmp1);
- }
- repr_tmp2 = repr;
- repr = g_strdup_printf("%s%c", repr_tmp2, end);
- free(repr_tmp2);
- return repr;
-}
-
-// Return a string representation of the MalVal object. Returned string must
-// be freed by caller.
-char *_pr_str(MalVal *obj, int print_readably) {
- char *repr = NULL;
- if (obj == NULL) { return NULL; }
- switch (obj->type) {
- case MAL_NIL:
- repr = g_strdup_printf("nil");
- break;
- case MAL_TRUE:
- repr = g_strdup_printf("true");
- break;
- case MAL_FALSE:
- repr = g_strdup_printf("false");
- break;
- case MAL_STRING:
- if (print_readably) {
- char *repr_tmp = g_strescape(obj->val.string, "");
- repr = g_strdup_printf("\"%s\"", repr_tmp);
- free(repr_tmp);
- } else {
- repr = g_strdup_printf("%s", obj->val.string);
- }
- break;
- case MAL_SYMBOL:
- repr = g_strdup_printf("%s", obj->val.string);
- break;
- case MAL_INTEGER:
- repr = g_strdup_printf("%" G_GINT64_FORMAT, obj->val.intnum);
- break;
- case MAL_FLOAT:
- repr = g_strdup_printf("%f", obj->val.floatnum);
- break;
- case MAL_HASH_MAP:
- repr = _pr_str_hash_map(obj, print_readably);
- break;
- case MAL_LIST:
- repr = _pr_str_list(obj, print_readably, '(', ')');
- break;
- case MAL_VECTOR:
- repr = _pr_str_list(obj, print_readably, '[', ']');
- break;
- case MAL_ATOM:
- repr = g_strdup_printf("(atom %s)",
- _pr_str(obj->val.atom_val, print_readably));
- break;
- case MAL_FUNCTION_C:
- repr = g_strdup_printf("#<function@%p>", obj->val.f0);
- break;
- case MAL_FUNCTION_MAL:
- repr = g_strdup_printf("#<Function: (fn* %s %s)>",
- _pr_str(obj->val.func.args, print_readably),
- _pr_str(obj->val.func.body, print_readably));
- break;
- default:
- printf("pr_str unknown type %d\n", obj->type);
- repr = g_strdup_printf("<unknown>");
- }
- return repr;
-}
-
-// Return a string representation of the MalVal arguments. Returned string must
-// be freed by caller.
-char *_pr_str_args(MalVal *args, char *sep, int print_readably) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "_pr_str called with non-sequential args");
- int i;
- char *repr = g_strdup_printf(""),
- *repr2 = NULL;
- for (i=0; i<_count(args); i++) {
- MalVal *obj = g_array_index(args->val.array, MalVal*, i);
- if (i != 0) {
- repr2 = repr;
- repr = g_strdup_printf("%s%s", repr2, sep);
- free(repr2);
- }
- repr2 = repr;
- repr = g_strdup_printf("%s%s",
- repr2, _pr_str(obj, print_readably));
- free(repr2);
- }
- return repr;
-}
-
-// Return a string representation of a MalVal sequence (in a format that can
-// be read by the reader). Returned string must be freed by caller.
-MalVal *pr_str(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "pr_str called with non-sequential args");
- return malval_new_string(_pr_str_args(args, " ", 1));
-}
-
-// Return a string representation of a MalVal sequence with every item
-// concatenated together. Returned string must be freed by caller.
-MalVal *str(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "str called with non-sequential args");
- return malval_new_string(_pr_str_args(args, "", 0));
-}
-
-// Print a string representation of a MalVal sequence (in a format that can
-// be read by the reader) followed by a newline. Returns nil.
-MalVal *prn(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "prn called with non-sequential args");
- char *repr = _pr_str_args(args, " ", 1);
- g_print("%s\n", repr);
- free(repr);
- return &mal_nil;
-}
-
-// Print a string representation of a MalVal sequence (for human consumption)
-// followed by a newline. Returns nil.
-MalVal *println(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "println called with non-sequential args");
- char *repr = _pr_str_args(args, " ", 0);
- g_print("%s\n", repr);
- free(repr);
- return &mal_nil;
-}
-
-MalVal *with_meta(MalVal *obj, MalVal *meta) {
- MalVal *new_obj = malval_new(obj->type, meta);
- new_obj->val = obj->val;
- return new_obj;
-}
-
-MalVal *meta(MalVal *obj) {
- assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_HASH_MAP|MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "attempt to get metadata from non-collection type");
- if (obj->metadata == NULL) {
- return &mal_nil;
- } else {
- return obj->metadata;
- }
-}
-
-
int _equal_Q(MalVal *a, MalVal *b) {
if (a == NULL || b == NULL) { return FALSE; }
@@ -498,170 +310,9 @@ int _equal_Q(MalVal *a, MalVal *b) {
}
}
-MalVal *equal_Q(MalVal *a, MalVal *b) {
- if (_equal_Q(a, b)) { return &mal_true; }
- else { return &mal_false; }
-}
-
-//
-// nil, true, false, string
-MalVal *nil_Q(MalVal *seq) { return seq->type & MAL_NIL ? &mal_true : &mal_false; }
-MalVal *true_Q(MalVal *seq) { return seq->type & MAL_TRUE ? &mal_true : &mal_false; }
-MalVal *false_Q(MalVal *seq) { return seq->type & MAL_FALSE ? &mal_true : &mal_false; }
-MalVal *string_Q(MalVal *seq) { return seq->type & MAL_STRING ? &mal_true : &mal_false; }
-
-//
-// 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; \
- }
-WRAP_INTEGER_OP(plus,+)
-WRAP_INTEGER_OP(minus,-)
-WRAP_INTEGER_OP(multiply,*)
-WRAP_INTEGER_OP(divide,/)
-WRAP_INTEGER_CMP_OP(gt,>)
-WRAP_INTEGER_CMP_OP(gte,>=)
-WRAP_INTEGER_CMP_OP(lt,<)
-WRAP_INTEGER_CMP_OP(lte,<=)
-
-
-//
-// Symbols
-MalVal *symbol_Q(MalVal *seq) { return seq->type & MAL_SYMBOL ? &mal_true : &mal_false; }
-
-
-// Hash maps
-//
-MalVal *_hash_map(int count, ...) {
- assert((count % 2) == 0,
- "odd number of parameters to hash-map");
- GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal);
- MalVal *hm = malval_new_hash_map(htable);
- char *k;
- MalVal *v;
- va_list ap;
- va_start(ap, count);
- while (count > 0) {
- k = va_arg(ap, char*);
- v = va_arg(ap, MalVal*);
- g_hash_table_insert(htable, k, v);
- count = count - 2;
- }
- va_end(ap);
- return hm;
-}
-
-MalVal *_assoc_BANG(MalVal* hm, MalVal *args) {
- assert((_count(args) % 2) == 0,
- "odd number of parameters to assoc!");
- GHashTable *htable = hm->val.hash_table;
- int i;
- MalVal *k, *v;
- for (i=0; i<_count(args); i+=2) {
- k = g_array_index(args->val.array, MalVal*, i);
- assert_type(k, MAL_STRING,
- "assoc! called with non-string key");
- v = g_array_index(args->val.array, MalVal*, i+1);
- g_hash_table_insert(htable, k->val.string, v);
- }
- return hm;
-}
-
-MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) {
- GHashTable *htable = hm->val.hash_table;
- int i;
- MalVal *k, *v;
- for (i=0; i<_count(args); i++) {
- k = g_array_index(args->val.array, MalVal*, i);
- assert_type(k, MAL_STRING,
- "dissoc! called with non-string key");
- g_hash_table_remove(htable, k->val.string);
- }
- return hm;
-}
-
-MalVal *hash_map(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "hash-map called with non-sequential arguments");
- GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal);
- MalVal *hm = malval_new_hash_map(htable);
- return _assoc_BANG(hm, args);
-}
-
-int _hash_map_Q(MalVal *seq) {
- return seq->type & MAL_HASH_MAP;
-}
-MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; }
-
-MalVal *assoc(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "assoc called with non-sequential arguments");
- assert(_count(args) >= 2,
- "assoc needs at least 2 arguments");
- GHashTable *htable = g_hash_table_copy(_nth(args,0)->val.hash_table);
- MalVal *hm = malval_new_hash_map(htable);
- return _assoc_BANG(hm, rest(args));
-}
-
-MalVal *dissoc(MalVal* args) {
- GHashTable *htable = g_hash_table_copy(_nth(args,0)->val.hash_table);
- MalVal *hm = malval_new_hash_map(htable);
- return _dissoc_BANG(hm, rest(args));
-}
-
-MalVal *keys(MalVal *obj) {
- assert_type(obj, MAL_HASH_MAP,
- "keys called on non-hash-map");
-
- GHashTableIter iter;
- gpointer key, value;
- MalVal *seq = malval_new_list(MAL_LIST,
- g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
- _count(obj)));
- g_hash_table_iter_init (&iter, obj->val.hash_table);
- while (g_hash_table_iter_next (&iter, &key, &value)) {
- MalVal *kname = malval_new_string((char *)key);
- g_array_append_val(seq->val.array, kname);
- }
- return seq;
-}
-
-MalVal *vals(MalVal *obj) {
- assert_type(obj, MAL_HASH_MAP,
- "vals called on non-hash-map");
-
- GHashTableIter iter;
- gpointer key, value;
- MalVal *seq = malval_new_list(MAL_LIST,
- g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
- _count(obj)));
- g_hash_table_iter_init (&iter, obj->val.hash_table);
- while (g_hash_table_iter_next (&iter, &key, &value)) {
- g_array_append_val(seq->val.array, value);
- }
- return seq;
-}
-
-
-// Errors/Exceptions
-void _error(const char *fmt, ...) {
- va_list args;
- va_start(args, fmt);
- mal_error = malval_new_string(g_strdup_vprintf(fmt, args));
-}
-void throw(MalVal *obj) {
- mal_error = obj;
-}
-
// Lists
-
-MalVal *_list(int count, ...) {
+MalVal *_listX(int count, ...) {
MalVal *seq = malval_new_list(MAL_LIST,
g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
count));
@@ -675,7 +326,8 @@ MalVal *_list(int count, ...) {
va_end(ap);
return seq;
}
-MalVal *list(MalVal *args) {
+
+MalVal *_list(MalVal *args) {
assert_type(args, MAL_LIST|MAL_VECTOR,
"list called with invalid arguments");
args->type = MAL_LIST;
@@ -685,116 +337,68 @@ MalVal *list(MalVal *args) {
int _list_Q(MalVal *seq) {
return seq->type & MAL_LIST;
}
-MalVal *list_Q(MalVal *seq) { return _list_Q(seq) ? &mal_true : &mal_false; }
// Vectors
-
-MalVal *_vector(int count, ...) {
- MalVal *seq = malval_new_list(MAL_VECTOR,
- g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
- count));
- MalVal *v;
- va_list ap;
- va_start(ap, count);
- while (count-- > 0) {
- v = va_arg(ap, MalVal*);
- g_array_append_val(seq->val.array, v);
- }
- va_end(ap);
- return seq;
-}
-MalVal *vector(MalVal *args) {
+MalVal *_vector(MalVal *args) {
assert_type(args, MAL_LIST|MAL_VECTOR,
"vector called with invalid arguments");
args->type = MAL_VECTOR;
return args;
}
-
int _vector_Q(MalVal *seq) {
return seq->type & MAL_VECTOR;
}
-MalVal *vector_Q(MalVal *seq) { return _vector_Q(seq) ? &mal_true : &mal_false; }
-// hash map and vector functions
-MalVal *get(MalVal *obj, MalVal *key) {
- MalVal *val;
- switch (obj->type) {
- case MAL_VECTOR:
- return _nth(obj, key->val.intnum);
- case MAL_HASH_MAP:
- if (g_hash_table_lookup_extended(obj->val.hash_table,
- key->val.string,
- NULL, (gpointer*)&val)) {
- return val;
- } else {
- return &mal_nil;
- }
- default:
- abort("get called on unsupported type %d", obj->type);
+// Hash maps
+MalVal *_hash_map(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "hash-map called with non-sequential arguments");
+ GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal);
+ MalVal *hm = malval_new_hash_map(htable);
+ return _assoc_BANG(hm, args);
+}
+
+int _hash_map_Q(MalVal *seq) {
+ return seq->type & MAL_HASH_MAP;
+}
+
+MalVal *_assoc_BANG(MalVal* hm, MalVal *args) {
+ assert((_count(args) % 2) == 0,
+ "odd number of parameters to assoc!");
+ GHashTable *htable = hm->val.hash_table;
+ int i;
+ MalVal *k, *v;
+ for (i=0; i<_count(args); i+=2) {
+ k = g_array_index(args->val.array, MalVal*, i);
+ assert_type(k, MAL_STRING,
+ "assoc! called with non-string key");
+ v = g_array_index(args->val.array, MalVal*, i+1);
+ g_hash_table_insert(htable, k->val.string, v);
}
+ return hm;
}
-MalVal *contains_Q(MalVal *obj, MalVal *key) {
- switch (obj->type) {
- case MAL_VECTOR:
- if (key->val.intnum < obj->val.array->len) {
- return &mal_true;
- } else {
- return &mal_false;
- }
- case MAL_HASH_MAP:
- if (g_hash_table_contains(obj->val.hash_table, key->val.string)) {
- return &mal_true;
- } else {
- return &mal_false;
- }
- default:
- abort("contains? called on unsupported type %d", obj->type);
+MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) {
+ GHashTable *htable = hm->val.hash_table;
+ int i;
+ MalVal *k, *v;
+ for (i=0; i<_count(args); i++) {
+ k = g_array_index(args->val.array, MalVal*, i);
+ assert_type(k, MAL_STRING,
+ "dissoc! called with non-string key");
+ g_hash_table_remove(htable, k->val.string);
}
+ return hm;
}
// Atoms
-MalVal *atom(MalVal *val) {
- return malval_new_atom(val);
-}
-
int _atom_Q(MalVal *exp) {
return exp->type & MAL_ATOM;
}
-MalVal *atom_Q(MalVal *exp) { return _atom_Q(exp) ? &mal_true : &mal_false; }
-
-MalVal *deref(MalVal *atm) {
- assert_type(atm, MAL_ATOM,
- "deref called on non-atom");
- return atm->val.atom_val;
-}
-
-MalVal *reset_BANG(MalVal *atm, MalVal *val) {
- assert_type(atm, MAL_ATOM,
- "reset! called with non-atom");
- atm->val.atom_val = val;
- return val;
-}
-
-MalVal *swap_BANG(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "swap! called with invalid arguments");
- assert(_count(args) >= 2,
- "swap! called with %d args, needs at least 2", _count(args));
- MalVal *atm = _nth(args, 0),
- *f = _nth(args, 1),
- *sargs = _slice(args, 2, _count(args)),
- *fargs = cons(atm->val.atom_val, sargs),
- *new_val = apply(f, fargs);
- if (mal_error) { return NULL; }
- atm->val.atom_val = new_val;
- return new_val;
-}
-
// Sequence functions
@@ -813,96 +417,6 @@ MalVal *_slice(MalVal *seq, int start, int end) {
int _sequential_Q(MalVal *seq) {
return seq->type & (MAL_LIST|MAL_VECTOR);
}
-MalVal *sequential_Q(MalVal *seq) {
- return _sequential_Q(seq) ? &mal_true : &mal_false;
-}
-
-MalVal *cons(MalVal *x, MalVal *seq) {
- assert_type(seq, MAL_LIST|MAL_VECTOR,
- "second argument to cons is non-sequential");
- int i, len = _count(seq);
- GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
- len+1);
- g_array_append_val(new_arr, x);
- for (i=0; i<len; i++) {
- g_array_append_val(new_arr, g_array_index(seq->val.array, MalVal*, i));
- }
- return malval_new_list(MAL_LIST, new_arr);
-}
-
-MalVal *count(MalVal *seq) {
- return malval_new_integer(_count(seq));
-}
-
-MalVal *empty_Q(MalVal *seq) {
- assert_type(seq, MAL_LIST|MAL_VECTOR,
- "empty? called with non-sequential");
- return (seq->val.array->len == 0) ? &mal_true : &mal_false;
-}
-
-MalVal *concat(MalVal *args) {
- MalVal *arg, *e, *lst;
- int i, j, arg_cnt = _count(args);
- lst = malval_new_list(MAL_LIST,
- g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), arg_cnt));
- for (i=0; i<arg_cnt; i++) {
- arg = g_array_index(args->val.array, MalVal*, i);
- assert_type(arg, MAL_LIST|MAL_VECTOR,
- "concat called with non-sequential");
- for (j=0; j<_count(arg); j++) {
- e = g_array_index(arg->val.array, MalVal*, j);
- g_array_append_val(lst->val.array, e);
- }
- }
-
- return lst;
-}
-
-MalVal *sconj(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "conj called with non-sequential");
- MalVal *src_lst = _nth(args, 0);
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "first argument to conj is non-sequential");
- int i, len = _count(src_lst) + _count(args) - 1;
- GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
- len);
- // Copy in src_lst
- for (i=0; i<_count(src_lst); i++) {
- g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i));
- }
- // Conj extra args
- for (i=1; i<_count(args); i++) {
- if (src_lst->type & MAL_LIST) {
- g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i));
- } else {
- g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i));
- }
- }
- return malval_new_list(src_lst->type, new_arr);
-}
-
-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 *_nth(MalVal *seq, int idx) {
assert_type(seq, MAL_LIST|MAL_VECTOR,
@@ -912,30 +426,6 @@ MalVal *_nth(MalVal *seq, int idx) {
}
return g_array_index(seq->val.array, MalVal*, idx);
}
-MalVal *nth(MalVal *seq, MalVal *idx) {
- return _nth(seq, idx->val.intnum);
-}
-
-MalVal *sapply(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "apply called with non-sequential");
- MalVal *f = _nth(args, 0);
- MalVal *last_arg = _nth(args, _count(args)-1);
- assert_type(last_arg, MAL_LIST|MAL_VECTOR,
- "last argument to apply is non-sequential");
- int i, len = _count(args) - 2 + _count(last_arg);
- GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
- len);
- // Initial arguments
- for (i=1; i<_count(args)-1; i++) {
- g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i));
- }
- // Add arguments from last_arg
- for (i=0; i<_count(last_arg); i++) {
- g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i));
- }
- return apply(f, malval_new_list(MAL_LIST, new_arr));
-}
MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) {
MalVal *e, *el;
@@ -951,136 +441,3 @@ MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) {
}
return el;
}
-
-MalVal *map(MalVal *mvf, MalVal *lst) {
- MalVal *res, *el;
- assert_type(mvf, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "map called with non-function");
- assert_type(lst, MAL_LIST|MAL_VECTOR,
- "map called with non-sequential");
- int i, len = _count(lst);
- el = malval_new_list(MAL_LIST,
- g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len));
- for (i=0; i<len; i++) {
- // TODO: this is replicating some of apply functionality
- if (mvf->type & MAL_FUNCTION_MAL) {
- Env *fn_env = new_env(mvf->val.func.env,
- mvf->val.func.args,
- _slice(lst, i, i+1));
- res = mvf->val.func.evaluator(mvf->val.func.body, fn_env);
- } else {
- res = mvf->val.f1(g_array_index(lst->val.array, MalVal*, i));
- }
- if (!res || mal_error) return NULL;
- g_array_append_val(el->val.array, res);
- }
- return el;
-}
-
-
-// Env
-
-Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) {
- Env *e = malloc(sizeof(Env));
- e->table = g_hash_table_new(g_str_hash, g_str_equal);
- e->outer = outer;
-
- if (binds && exprs) {
- assert_type(binds, MAL_LIST|MAL_VECTOR,
- "new_env called with non-sequential bindings");
- assert_type(exprs, MAL_LIST|MAL_VECTOR,
- "new_env called with non-sequential expressions");
- int binds_len = _count(binds),
- exprs_len = _count(exprs),
- varargs = 0, i;
- for (i=0; i<binds_len; i++) {
- if (i > exprs_len) { break; }
- if (_nth(binds, i)->val.string[0] == '&') {
- varargs = 1;
- env_set(e, _nth(binds, i+1)->val.string, _slice(exprs, i, _count(exprs)));
- break;
- } else {
- env_set(e, _nth(binds, i)->val.string, _nth(exprs, i));
- }
- }
- assert(varargs || (binds_len == exprs_len),
- "Arity mismatch: %d formal params vs %d actual params",
- binds_len, exprs_len);
-
- }
- return e;
-}
-
-Env *env_find(Env *env, char *key) {
- void *val = g_hash_table_lookup(env->table, key);
- if (val) {
- return env;
- } else if (env->outer) {
- return env_find(env->outer, key);
- } else {
- return NULL;
- }
-}
-
-MalVal *env_get(Env *env, char *key) {
- Env *e = env_find(env, key);
- assert(e, "'%s' not found", key);
- return g_hash_table_lookup(e->table, key);
-}
-
-Env *env_set(Env *env, char *key, MalVal *val) {
- g_hash_table_insert(env->table, key, val);
- return env;
-}
-
-types_ns_entry types_ns[49] = {
- {"pr-str", (void*(*)(void*))pr_str, -1},
- {"str", (void*(*)(void*))str, -1},
- {"prn", (void*(*)(void*))prn, -1},
- {"println", (void*(*)(void*))println, -1},
- {"with-meta", (void*(*)(void*))with_meta, 2},
- {"meta", (void*(*)(void*))meta, 1},
- {"=", (void*(*)(void*))equal_Q, 2},
- {"symbol?", (void*(*)(void*))symbol_Q, 1},
- {"nil?", (void*(*)(void*))nil_Q, 1},
- {"true?", (void*(*)(void*))true_Q, 1},
- {"false?", (void*(*)(void*))false_Q, 1},
- {"+", (void*(*)(void*))int_plus, 2},
- {"-", (void*(*)(void*))int_minus, 2},
- {"*", (void*(*)(void*))int_multiply, 2},
- {"/", (void*(*)(void*))int_divide, 2},
- {">", (void*(*)(void*))int_gt, 2},
- {">=", (void*(*)(void*))int_gte, 2},
- {"<", (void*(*)(void*))int_lt, 2},
- {"<=", (void*(*)(void*))int_lte, 2},
- {"hash-map", (void*(*)(void*))hash_map, -1},
- {"map?", (void*(*)(void*))hash_map_Q, 1},
- {"assoc", (void*(*)(void*))assoc, -1},
- {"dissoc", (void*(*)(void*))dissoc, -1},
- {"get", (void*(*)(void*))get, 2},
- {"contains?", (void*(*)(void*))contains_Q, 2},
- {"keys", (void*(*)(void*))keys, 1},
- {"vals", (void*(*)(void*))vals, 1},
- {"throw", (void*(*)(void*))throw, 1},
- {"list", (void*(*)(void*))list, -1},
- {"list?", (void*(*)(void*))list_Q, 1},
- {"vector", (void*(*)(void*))vector, -1},
- {"vector?", (void*(*)(void*))vector_Q, 1},
- {"atom", (void*(*)(void*))atom, 1},
- {"atom?", (void*(*)(void*))atom_Q, 1},
- {"deref", (void*(*)(void*))deref, 1},
- {"reset!", (void*(*)(void*))reset_BANG, 2},
- {"swap!", (void*(*)(void*))swap_BANG, -1},
- {"sequential?", (void*(*)(void*))sequential_Q, 1},
- {"cons", (void*(*)(void*))cons, 2},
- {"count", (void*(*)(void*))count, 1},
- {"empty?", (void*(*)(void*))empty_Q, 1},
- {"concat", (void*(*)(void*))concat, -1},
- {"conj", (void*(*)(void*))sconj, -1},
- {"first", (void*(*)(void*))first, 1},
- {"last", (void*(*)(void*))last, 1},
- {"rest", (void*(*)(void*))rest, 1},
- {"nth", (void*(*)(void*))nth, 2},
- {"apply", (void*(*)(void*))sapply, -1},
- {"map", (void*(*)(void*))map, 2},
- };
diff --git a/c/types.h b/c/types.h
index 271a899..d65e4ef 100644
--- a/c/types.h
+++ b/c/types.h
@@ -3,10 +3,32 @@
#include <glib.h>
-// State
struct MalVal; // pre-declare
+
+
+// Env (implentation in env.c)
+
+typedef struct Env {
+ struct Env *outer;
+ GHashTable *table;
+} Env;
+
+Env *new_env(Env *outer, struct MalVal* binds, struct MalVal *exprs);
+Env *env_find(Env *env, char *key);
+struct MalVal *env_get(Env *env, char *key);
+Env *env_set(Env *env, char *key, struct MalVal *val);
+
+
+// Utility functiosn
+void g_hash_table_print(GHashTable *hash_table);
+GHashTable *g_hash_table_copy(GHashTable *src_table);
+
+
+// Errors/exceptions
+
extern struct MalVal *mal_error;
+void _error(const char *fmt, ...);
#define abort(format, ...) \
{ _error(format, ##__VA_ARGS__); return NULL; }
@@ -23,6 +45,7 @@ extern struct MalVal *mal_error;
return NULL; \
}
+
typedef enum {
MAL_NIL = 1,
MAL_TRUE = 2,
@@ -39,10 +62,6 @@ typedef enum {
MAL_FUNCTION_MAL = 4096,
} MalType;
-
-// Predeclare Env
-typedef struct Env Env;
-
typedef struct MalVal {
MalType type;
struct MalVal *metadata;
@@ -112,51 +131,24 @@ MalVal *malval_new_float(gdouble val);
MalVal *malval_new_string(char *val);
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 *hash_map(MalVal *args);
-void _error(const char *fmt, ...);
-MalVal *_list(int count, ...);
+MalVal *_listX(int count, ...);
+MalVal *_list(MalVal *args);
+MalVal *_vector(MalVal *args);
+MalVal *_hash_map(MalVal *args);
+MalVal *_assoc_BANG(MalVal* hm, MalVal *args);
+MalVal *_dissoc_BANG(MalVal* hm, MalVal *args);
-MalVal *apply(MalVal *f, MalVal *el);
+MalVal *_apply(MalVal *f, MalVal *el);
char *_pr_str(MalVal *args, int print_readably);
-MalVal *first(MalVal* seq);
-MalVal *last(MalVal* seq);
MalVal *_slice(MalVal *seq, int start, int end);
MalVal *_nth(MalVal *seq, int idx);
-MalVal *rest(MalVal *seq);
MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2);
-// These are just used by step2 and step3 before then type_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);
-
-// Env
-
-typedef struct Env {
- struct Env *outer;
- GHashTable *table;
-} Env;
-
-Env *new_env(Env *outer, MalVal* binds, MalVal *exprs);
-Env *env_find(Env *env, char *key);
-MalVal *env_get(Env *env, char *key);
-Env *env_set(Env *env, char *key, MalVal *val);
-
-// namespace of type functions
-typedef struct {
- char *name;
- void *(*func)(void*);
- int arg_cnt;
-} types_ns_entry;
-
-extern types_ns_entry types_ns[49];
-
#endif
generated by cgit v1.2.3 (git 2.25.1) at 2026-01-01 21:04:18 +0000