From 21986733a1ae07ec11f74ef6e4b1a4dbbf682de1 Mon Sep 17 00:00:00 2001 From: Dov Murik Date: Tue, 12 Sep 2017 20:51:40 +0000 Subject: [PATCH] Yorick implementation --- Makefile | 3 +- yorick/Dockerfile | 26 +++ yorick/Makefile | 24 +++ yorick/core.i | 343 ++++++++++++++++++++++++++++++++++++++ yorick/env.i | 44 +++++ yorick/hash.i | 79 +++++++++ yorick/printer.i | 50 ++++++ yorick/reader.i | 155 +++++++++++++++++ yorick/run | 3 + yorick/step0_repl.i | 33 ++++ yorick/step1_read_print.i | 43 +++++ yorick/step2_eval.i | 96 +++++++++++ yorick/step3_env.i | 113 +++++++++++++ yorick/step4_if_fn_do.i | 155 +++++++++++++++++ yorick/step5_tco.i | 162 ++++++++++++++++++ yorick/step6_file.i | 190 +++++++++++++++++++++ yorick/step7_quote.i | 215 ++++++++++++++++++++++++ yorick/step8_macros.i | 251 ++++++++++++++++++++++++++++ yorick/step9_try.i | 265 +++++++++++++++++++++++++++++ yorick/stepA_mal.i | 270 ++++++++++++++++++++++++++++++ yorick/types.i | 166 ++++++++++++++++++ 21 files changed, 2685 insertions(+), 1 deletion(-) create mode 100644 yorick/Dockerfile create mode 100644 yorick/Makefile create mode 100644 yorick/core.i create mode 100644 yorick/env.i create mode 100644 yorick/hash.i create mode 100644 yorick/printer.i create mode 100644 yorick/reader.i create mode 100755 yorick/run create mode 100644 yorick/step0_repl.i create mode 100644 yorick/step1_read_print.i create mode 100644 yorick/step2_eval.i create mode 100644 yorick/step3_env.i create mode 100644 yorick/step4_if_fn_do.i create mode 100644 yorick/step5_tco.i create mode 100644 yorick/step6_file.i create mode 100644 yorick/step7_quote.i create mode 100644 yorick/step8_macros.i create mode 100644 yorick/step9_try.i create mode 100644 yorick/stepA_mal.i create mode 100644 yorick/types.i diff --git a/Makefile b/Makefile index 100e2f9086..dbd80c7216 100644 --- a/Makefile +++ b/Makefile @@ -83,7 +83,7 @@ IMPLS = ada awk bash basic c d chuck clojure coffee common-lisp cpp crystal cs d haxe hy io java julia js kotlin logo lua make mal ocaml matlab miniMAL \ nim objc objpascal perl perl6 php pil plpgsql plsql powershell ps \ python r racket rexx rpython ruby rust scala scheme skew swift swift3 tcl \ - ts vb vhdl vimscript livescript elm + ts vb vhdl vimscript yorick livescript elm EXTENSION = .mal @@ -238,6 +238,7 @@ ts_STEP_TO_PROG = ts/$($(1)).js vb_STEP_TO_PROG = vb/$($(1)).exe vhdl_STEP_TO_PROG = vhdl/$($(1)) vimscript_STEP_TO_PROG = vimscript/$($(1)).vim +yorick_STEP_TO_PROG = yorick/$($(1)).i guile_STEP_TO_PROG = guile/$($(1)).scm livescript_STEP_TO_PROG = livescript/$($(1)).js elm_STEP_TO_PROG = elm/$($(1)).js diff --git a/yorick/Dockerfile b/yorick/Dockerfile new file mode 100644 index 0000000000..8a3f0037f3 --- /dev/null +++ b/yorick/Dockerfile @@ -0,0 +1,26 @@ +FROM ubuntu:xenial +MAINTAINER Joel Martin + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python + +# Some typical implementation and test requirements +RUN apt-get -y install curl libreadline-dev libedit-dev + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install yorick yorick-yeti yorick-yeti-regex + +ENV HOME /mal diff --git a/yorick/Makefile b/yorick/Makefile new file mode 100644 index 0000000000..ccc3d68740 --- /dev/null +++ b/yorick/Makefile @@ -0,0 +1,24 @@ +SOURCES_BASE = hash.i types.i reader.i printer.i +SOURCES_LISP = env.i core.i stepA_mal.i +SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) + +.PHONY: all dist clean stats stats-lisp + +all: dist + +dist: mal + +mal: $(SOURCES) + echo "#!/usr/bin/yorick -batch" > $@ + cat $+ | grep -v "^require," >> $@ + chmod +x $@ + +clean: + rm -f mal + +stats: $(SOURCES) + @wc $^ + @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" +stats-lisp: $(SOURCES_LISP) + @wc $^ + @printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*//|^[[:space:]]*$$" $^ | wc` "[comments/blanks]" diff --git a/yorick/core.i b/yorick/core.i new file mode 100644 index 0000000000..167f388c81 --- /dev/null +++ b/yorick/core.i @@ -0,0 +1,343 @@ +require, "types.i" + +func mal_equal(a) { return new_boolean(equal(*a(1), *a(2))); } +func mal_throw(a) { return MalError(obj=a(1)); } + +func mal_nil_q(a) { return new_boolean(structof(*a(1)) == MalNil); } +func mal_true_q(a) { return new_boolean(structof(*a(1)) == MalTrue); } +func mal_false_q(a) { return new_boolean(structof(*a(1)) == MalFalse); } +func mal_string_q(a) { return new_boolean(structof(*a(1)) == MalString); } +func mal_symbol(a) { return MalSymbol(val=a(1)->val); } +func mal_symbol_q(a) { return new_boolean(structof(*a(1)) == MalSymbol); } +func mal_keyword(a) { return MalKeyword(val=a(1)->val); } +func mal_keyword_q(a) { return new_boolean(structof(*a(1)) == MalKeyword); } + +func string_helper(a, delimiter, readable) +{ + res = "" + for (i = 1; i <= numberof(a); ++i) { + if (i > 1) res += delimiter + res += pr_str(*a(i), readable) + } + return res +} + +func mal_pr_str(a) { return MalString(val=string_helper(a, " ", 1)); } +func mal_str(a) { return MalString(val=string_helper(a, "", 0)); } +func mal_prn(a) { write, format="%s\n", string_helper(a, " ", 1); return MAL_NIL; } +func mal_println(a) { write, format="%s\n", string_helper(a, " ", 0); return MAL_NIL; } +func mal_read_string(a) { return read_str(a(1)->val); } + +func mal_readline(a) +{ + extern stdin_file + write, format="%s", a(1)->val + line = rdline(stdin_file, prompt="") + return line ? MalString(val=line) : MAL_NIL +} + +func mal_slurp(a) +{ + f = open(a(1)->val) + lines = rdfile(f) + close, f + s = "" + for (i = 1; i <= numberof(lines); ++i) { + s += (lines(i) + "\n") + } + return MalString(val=s) +} + +func mal_lt(a) { return new_boolean(a(1)->val < a(2)->val); } +func mal_lte(a) { return new_boolean(a(1)->val <= a(2)->val); } +func mal_gt(a) { return new_boolean(a(1)->val > a(2)->val); } +func mal_gte(a) { return new_boolean(a(1)->val >= a(2)->val); } + +func mal_add(a) { return MalNumber(val=(a(1)->val + a(2)->val)); } +func mal_sub(a) { return MalNumber(val=(a(1)->val - a(2)->val)); } +func mal_mul(a) { return MalNumber(val=(a(1)->val * a(2)->val)); } +func mal_div(a) { return MalNumber(val=(a(1)->val / a(2)->val)); } + +func mal_time_ms(a) +{ + elapsed = array(double, 3) + timer, elapsed + return MalNumber(val=floor(elapsed(3) * 1000)) +} + +func mal_list(a) { return MalList(val=&a); } +func mal_list_q(a) { return new_boolean(structof(*a(1)) == MalList); } +func mal_vector(a) { return MalVector(val=&a); } +func mal_vector_q(a) { return new_boolean(structof(*a(1)) == MalVector); } +func mal_hash_map(a) { return array_to_hashmap(a); } +func mal_map_q(a) { return new_boolean(structof(*a(1)) == MalHashmap); } + +func mal_assoc(a) { + h = *(a(1)->val) + k1 = *h.keys + v1 = *h.vals + new_h = Hash(keys=&k1, vals=&v1) + for (i = 2; i <= numberof(a); i += 2) { + hash_set, new_h, hashmap_obj_to_key(*a(i)), *a(i + 1) + } + return MalHashmap(val=&new_h); +} + +func mal_dissoc(a) { + h = *(a(1)->val) + k1 = *h.keys + v1 = *h.vals + new_h = Hash(keys=&k1, vals=&v1) + for (i = 2; i <= numberof(a); ++i) { + hash_delete, new_h, hashmap_obj_to_key(*a(i)) + } + return MalHashmap(val=&new_h); +} + +func mal_get(a) { + if (structof(*a(1)) == MalNil) return MAL_NIL + h = *(a(1)->val) + key_obj = *a(2) + val = hash_get(h, hashmap_obj_to_key(key_obj)) + return is_void(val) ? MAL_NIL : val +} + +func mal_contains_q(a) { + if (structof(*a(1)) == MalNil) return MAL_FALSE + h = *(a(1)->val) + key_obj = *a(2) + return hash_has_key(h, hashmap_obj_to_key(key_obj)) ? MAL_TRUE : MAL_FALSE +} + +func mal_keys(a) { + keys_strs = *(a(1)->val->keys) + if (numberof(keys_strs) == 0) return MalList(val=&[]) + res = array(pointer, numberof(keys_strs)) + for (i = 1; i <= numberof(keys_strs); ++i) { + res(i) = &hashmap_key_to_obj(keys_strs(i)) + } + return MalList(val=&res); +} + +func mal_vals(a) { return MalList(val=a(1)->val->vals); } + +func mal_sequential_q(a) { return new_boolean(structof(*a(1)) == MalList || structof(*a(1)) == MalVector); } + +func mal_cons(a) +{ + a2_len = count(*a(2)) + seq = array(pointer, a2_len + 1) + seq(1) = a(1) + if (a2_len > 0) { + seq(2:) = *(a(2)->val) + } + return MalList(val=&seq) +} + +func mal_concat(a) +{ + seq = [] + for (i = 1; i <= numberof(a); ++i) { + grow, seq, *(a(i)->val) + } + return MalList(val=&seq) +} + +func mal_nth(a) +{ + index = a(2)->val + if (index >= count(*a(1))) return MalError(message="nth: index out of range") + return *((*(a(1)->val))(index + 1)) +} + +func mal_first(a) +{ + if (structof(*a(1)) == MalNil || count(*a(1)) == 0) return MAL_NIL + return *((*(a(1)->val))(1)) +} + +func mal_rest(a) +{ + if (structof(*a(1)) == MalNil) return MalList(val=&[]) + return rest(*a(1)) +} + +func mal_empty_q(a) { return new_boolean((structof(*a(1)) == MalNil ? 1 : count(*a(1)) == 0)); } +func mal_count(a) { return MalNumber(val=(structof(*a(1)) == MalNil ? 0 : count(*a(1)))); } + +func call_func(fn, args) +{ + if (structof(fn) == MalNativeFunction) { + return call_core_fn(fn.val, args) + } else if (structof(fn) == MalFunction) { + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) + return EVAL(*fn.ast, fn_env) + } else { + return MalError(message="Unknown function type") + } +} + +func mal_apply(a) { + mid_args = numberof(a) > 2 ? a(2:-1) : [] + return call_func(*a(1), grow(mid_args, *(a(0)->val))) +} + +func mal_map(a) { + fn = *a(1) + seq = *(a(2)->val) + if (numberof(seq) == 0) return MalList(val=&[]) + new_seq = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + new_val = call_func(fn, [seq(i)]) + if (structof(new_val) == MalError) return new_val + new_seq(i) = &new_val + } + return MalList(val=&new_seq) +} + +func mal_conj(a) +{ + obj = *a(1) + type = structof(obj) + if (type == MalList) { + res = obj + for (i = 2; i <= numberof(a); ++i) { + res = mal_cons([a(i), &res]) + } + return res + } else if (type == MalVector) { + seq = *obj.val + grow, seq, a(2:) + return MalVector(val=&seq) + } else { + return MalError(message="conj requires list or vector") + } +} + +func mal_seq(a) +{ + obj = *a(1) + type = structof(obj) + if (type == MalString) { + len = strlen(obj.val) + if (len == 0) return MAL_NIL + seq = array(pointer, len) + for (i = 1; i <= len; ++i) { + seq(i) = &MalString(val=strpart(obj.val, i:i)) + } + return MalList(val=&seq) + } else if (type == MalList) { + return count(obj) == 0 ? MAL_NIL : obj + } else if (type == MalVector) { + return count(obj) == 0 ? MAL_NIL : MalList(val=obj.val) + } else if (type == MalNil) { + return MAL_NIL + } else { + return MalError(message="seq requires string or list or vector or nil") + } +} + +func mal_meta(a) +{ + meta_obj = *(a(1)->meta) + return is_void(meta_obj) ? MAL_NIL : meta_obj +} + +func mal_with_meta(a) +{ + new_obj = *a(1) + new_obj.meta = a(2) + return new_obj +} + +func mal_atom(a) { return MalAtom(val=&MalAtomVal(val=a(1))); } +func mal_atom_q(a) { return new_boolean(structof(*a(1)) == MalAtom); } +func mal_deref(a) { return *(a(1)->val->val); } +func mal_reset_bang(a) { a(1)->val->val = a(2); return *(a(1)->val->val); } +func mal_swap_bang(a) +{ + old_val = mal_deref([a(1)]) + args = array(pointer, numberof(a) - 1) + args(1) = &old_val + if (numberof(a) > 2) args(2:) = a(3:) + new_val = call_func(*a(2), args) + if (structof(new_val) == MalError) return new_val + return mal_reset_bang([a(1), &new_val]) +} + +func mal_eval(a) { return EVAL(*a(1), repl_env); } + +core_ns = h_new() + +h_set, core_ns, "=", mal_equal +h_set, core_ns, "throw", mal_throw + +h_set, core_ns, "nil?", mal_nil_q +h_set, core_ns, "true?", mal_true_q +h_set, core_ns, "false?", mal_false_q +h_set, core_ns, "string?", mal_string_q +h_set, core_ns, "symbol", mal_symbol +h_set, core_ns, "symbol?", mal_symbol_q +h_set, core_ns, "keyword", mal_keyword +h_set, core_ns, "keyword?", mal_keyword_q + +h_set, core_ns, "pr-str", mal_pr_str +h_set, core_ns, "str", mal_str +h_set, core_ns, "prn", mal_prn +h_set, core_ns, "println", mal_println +h_set, core_ns, "read-string", mal_read_string +h_set, core_ns, "readline", mal_readline +h_set, core_ns, "slurp", mal_slurp + +h_set, core_ns, "<", mal_lt +h_set, core_ns, "<=", mal_lte +h_set, core_ns, ">", mal_gt +h_set, core_ns, ">=", mal_gte +h_set, core_ns, "+", mal_add +h_set, core_ns, "-", mal_sub +h_set, core_ns, "*", mal_mul +h_set, core_ns, "/", mal_div +h_set, core_ns, "time-ms", mal_time_ms + +h_set, core_ns, "list", mal_list +h_set, core_ns, "list?", mal_list_q +h_set, core_ns, "vector", mal_vector +h_set, core_ns, "vector?", mal_vector_q +h_set, core_ns, "hash-map", mal_hash_map +h_set, core_ns, "map?", mal_map_q +h_set, core_ns, "assoc", mal_assoc +h_set, core_ns, "dissoc", mal_dissoc +h_set, core_ns, "get", mal_get +h_set, core_ns, "contains?", mal_contains_q +h_set, core_ns, "keys", mal_keys +h_set, core_ns, "vals", mal_vals + +h_set, core_ns, "sequential?", mal_sequential_q +h_set, core_ns, "cons", mal_cons +h_set, core_ns, "concat", mal_concat +h_set, core_ns, "nth", mal_nth +h_set, core_ns, "first", mal_first +h_set, core_ns, "rest", mal_rest +h_set, core_ns, "empty?", mal_empty_q +h_set, core_ns, "count", mal_count +h_set, core_ns, "apply", mal_apply +h_set, core_ns, "map", mal_map + +h_set, core_ns, "conj", mal_conj +h_set, core_ns, "seq", mal_seq + +h_set, core_ns, "meta", mal_meta +h_set, core_ns, "with-meta", mal_with_meta +h_set, core_ns, "atom", mal_atom +h_set, core_ns, "atom?", mal_atom_q +h_set, core_ns, "deref", mal_deref +h_set, core_ns, "reset!", mal_reset_bang +h_set, core_ns, "swap!", mal_swap_bang + +h_set, core_ns, "eval", mal_eval + +func call_core_fn(name, args_list) +{ + f = h_get(core_ns, name) + return f(args_list) +} diff --git a/yorick/env.i b/yorick/env.i new file mode 100644 index 0000000000..d1e8a9cdc0 --- /dev/null +++ b/yorick/env.i @@ -0,0 +1,44 @@ +require, "hash.i" +require, "types.i" + +struct Env { + pointer outer + Hash data +} + +func env_new(outer_ptr, binds=, exprs=) +{ + env = Env(outer=outer_ptr, data=hash_new()) + for (i = 1; i <= numberof(binds); ++i) { + if (binds(i)->val == "&") { + rest_args = numberof(exprs) >= i ? exprs(i:) : [] + env_set, env, binds(i + 1)->val, MalList(val=&rest_args) + break + } else { + env_set, env, binds(i)->val, *exprs(i) + } + } + return env +} + +func env_find(env, key) +{ + if (hash_has_key(env.data, key)) return env + if (is_void(*env.outer)) return nil + return env_find(*env.outer, key) +} + +func env_get(env, key) +{ + found_env = env_find(env, key) + if (is_void(found_env)) return MalError(message=("'" + key + "' not found")) + return hash_get(found_env.data, key) +} + +func env_set(&env, key, val) +{ + d = env.data + hash_set, d, key, val + env.data = d + return val +} diff --git a/yorick/hash.i b/yorick/hash.i new file mode 100644 index 0000000000..250e4c72dc --- /dev/null +++ b/yorick/hash.i @@ -0,0 +1,79 @@ +// Implement our old naive O(n) map because Yeti's hash table (h_new()) cannot +// be used inside arrays and structs (we can't get a pointer to hash table). +// This prevents saving pointer to environment in MalFunction for example. + +struct Hash { + pointer keys + pointer vals +} + +func hash_new(void) +{ + return Hash(keys=&[], vals=&[]) +} + +func hash_get(h, key) +{ + for (i = 1; i <= numberof(*h.keys); ++i) { + if ((*h.keys)(i) == key) return *((*h.vals)(i)) + } + return nil +} + +func hash_has_key(h, key) +{ + for (i = 1; i <= numberof(*h.keys); ++i) { + if ((*h.keys)(i) == key) return 1 + } + return 0 +} + +func hash_set(&h, key, val) +{ + if (is_void(*h.keys)) { + h.keys = &[key] + h.vals = &[&val] + return + } + for (i = 1; i <= numberof(*h.keys); ++i) { + if ((*h.keys)(i) == key) { + (*h.vals)(i) = &val + return + } + } + tmp = *h.keys + grow, tmp, [key] + h.keys = &tmp + tmp = *h.vals + grow, tmp, [&val] + h.vals = &tmp +} + +func hash_delete(&h, key) +{ + if (is_void(*h.keys) || numberof(*h.keys) == 0) return + k = *h.keys + v = *h.vals + if (numberof(k) == 1) { + if (k(1) == key) { + h.keys = &[] + h.vals = &[] + return + } + } + for (i = 1; i <= numberof(k); ++i) { + if (k(i) == key) { + if (i == 1) { + h.keys = &(k(i+1:)) + h.vals = &(v(i+1:)) + } else if (i == numberof(k)) { + h.keys = &(k(1:i-1)) + h.vals = &(v(1:i-1)) + } else { + h.keys = &grow(k(1:i-1), k(i+1:)) + h.vals = &grow(v(1:i-1), v(i+1:)) + } + return + } + } +} diff --git a/yorick/printer.i b/yorick/printer.i new file mode 100644 index 0000000000..acefd17c26 --- /dev/null +++ b/yorick/printer.i @@ -0,0 +1,50 @@ +require, "types.i" + +func format_seq(val, start_char, end_char, readable) +{ + seq = *val + res = "" + for (i = 1; i <= numberof(seq); ++i) { + if (i > 1) res += " " + res += pr_str(*seq(i), readable) + } + return start_char + res + end_char +} + +func format_hashmap(h, readable) +{ + res = "" + for (i = 1; i <= numberof(*h.keys); ++i) { + if (i > 1) res += " " + key = hashmap_key_to_obj((*h.keys)(i)) + res += pr_str(key, readable) + " " + pr_str(*((*h.vals)(i)), readable) + } + return "{" + res + "}" +} + +func escape(s) +{ + s1 = streplaceall(s, "\\", "\\\\") + s2 = streplaceall(s1, "\"", "\\\"") + s3 = streplaceall(s2, "\n", "\\n") + return "\"" + s3 + "\"" +} + +func pr_str(ast, readable) +{ + type = structof(ast) + if (type == MalNil) return "nil" + else if (type == MalTrue) return "true" + else if (type == MalFalse) return "false" + else if (type == MalNumber) return totxt(ast.val) + else if (type == MalSymbol) return ast.val + else if (type == MalString) return readable ? escape(ast.val) : ast.val + else if (type == MalKeyword) return ":" + ast.val + else if (type == MalList) return format_seq(ast.val, "(", ")", readable) + else if (type == MalVector) return format_seq(ast.val, "[", "]", readable) + else if (type == MalHashmap) return format_hashmap(*ast.val, readable) + else if (type == MalAtom) return "(atom " + pr_str(*(ast.val->val), readable) + ")" + else if (type == MalNativeFunction) return "#" + else if (type == MalFunction) return "#" + else MalError(message=("Unknown type " + totxt(type))) +} diff --git a/yorick/reader.i b/yorick/reader.i new file mode 100644 index 0000000000..3b7e90f09b --- /dev/null +++ b/yorick/reader.i @@ -0,0 +1,155 @@ +#include "yeti_regex.i" +require, "types.i" + +TOKENIZER_REGEXP = regcomp("[[:space:],]*(~@|[][{}()'`~@]|\"([\\].|[^\\\"])*\"|;.*|[^][[:space:]{}()'\"`~@,;]*)", newline=1) + +func tokenize(str) +{ + match0 = "" + match1 = "" + pos = 1 + tokens = [] + while (1) { + m = regmatch(TOKENIZER_REGEXP, str, match0, match1, start=pos, indices=1) + if (m == 0) break + b = match1(1) + e = match1(2) - 1 + if (e < b) { + pos = match1(2) + 1 + continue + } + token = strpart(str, b:e) + pos = match1(2) + if (strpart(token, 1:1) == ";") continue + grow, tokens, [token] + } + return tokens +} + +struct Reader { + pointer tokens + int pos +} + +func reader_peek(rdr) +{ + if (rdr.pos > numberof(*rdr.tokens)) return string(0) + return (*rdr.tokens)(rdr.pos) +} + +func reader_next(rdr) +{ + token = reader_peek(rdr) + rdr.pos += 1 + return token +} + +NUMBER_REGEXP = regcomp("^-?[0-9]+$") + +func unescape(s) +{ + s1 = strpart(s, 2:-1) // remove surrounding quotes + s2 = streplaceall(s1, "\\n", "\n") + s3 = streplaceall(s2, "\\\"", "\"") + return streplaceall(s3, "\\\\", "\\") +} + +func read_atom(rdr) +{ + token = reader_next(rdr) + if (token == "nil") return MAL_NIL + else if (token == "true") return MAL_TRUE + else if (token == "false") return MAL_FALSE + else if (regmatch(NUMBER_REGEXP, token)) return MalNumber(val=tonum(token)) + else if (strpart(token, 1:1) == "\"") return MalString(val=unescape(token)) + else if (strpart(token, 1:1) == ":") return MalKeyword(val=strpart(token, 2:)) + else return MalSymbol(val=token) +} + +func read_seq(rdr, start_char, end_char) +{ + token = reader_next(rdr) + if (token != start_char) { + return MalError(message=("expected '" + start_char + "'")) + } + + elements = [] + token = reader_peek(rdr) + while (token != end_char) { + if (token == string(0)) { + return MalError(message=("expected '" + end_char + "'")) + } + e = read_form(rdr) + if (structof(e) == MalError) return e + grow, elements, [&e] + token = reader_peek(rdr) + } + token = reader_next(rdr) + return elements +} + +func read_list(rdr) +{ + seq = read_seq(rdr, "(", ")") + if (structof(seq) == MalError) return seq + return MalList(val=&seq) +} + +func read_vector(rdr) +{ + seq = read_seq(rdr, "[", "]") + if (structof(seq) == MalError) return seq + return MalVector(val=&seq) +} + +func read_hashmap(rdr) +{ + seq = read_seq(rdr, "{", "}") + if (structof(seq) == MalError) return seq + return array_to_hashmap(seq) +} + +func reader_macro(rdr, symbol_name) +{ + shortcut = reader_next(rdr) + form = read_form(rdr) + if (structof(form) == MalError) return form + seq = [&MalSymbol(val=symbol_name), &form] + return MalList(val=&seq) +} + +func reader_with_meta_macro(rdr) +{ + shortcut = reader_next(rdr) + meta = read_form(rdr) + if (structof(meta) == MalError) return meta + form = read_form(rdr) + if (structof(form) == MalError) return form + seq = [&MalSymbol(val="with-meta"), &form, &meta] + return MalList(val=&seq) +} + +func read_form(rdr) +{ + token = reader_peek(rdr) + if (token == "'") return reader_macro(rdr, "quote") + else if (token == "`") return reader_macro(rdr, "quasiquote") + else if (token == "~") return reader_macro(rdr, "unquote") + else if (token == "~@") return reader_macro(rdr, "splice-unquote") + else if (token == "@") return reader_macro(rdr, "deref") + else if (token == "^") return reader_with_meta_macro(rdr) + else if (token == "(") return read_list(rdr) + else if (token == ")") return MalError(message="unexpected ')'") + else if (token == "[") return read_vector(rdr) + else if (token == "]") return MalError(message="unexpected ']'") + else if (token == "{") return read_hashmap(rdr) + else if (token == "}") return MalError(message="unexpected '}'") + else return read_atom(rdr) +} + +func read_str(str) +{ + tokens = tokenize(str) + rdr = Reader(tokens=&tokens, pos=1) + return read_form(rdr) +} diff --git a/yorick/run b/yorick/run new file mode 100755 index 0000000000..c54589bb04 --- /dev/null +++ b/yorick/run @@ -0,0 +1,3 @@ +#!/bin/bash +export YORICK_MAL_PATH="$(dirname $0)" +exec yorick -batch "$YORICK_MAL_PATH/${STEP:-stepA_mal}.i" "${@}" diff --git a/yorick/step0_repl.i b/yorick/step0_repl.i new file mode 100644 index 0000000000..6a7fa25016 --- /dev/null +++ b/yorick/step0_repl.i @@ -0,0 +1,33 @@ +func READ(str) +{ + return str +} + +func EVAL(exp, env) +{ + return exp +} + +func PRINT(exp) +{ + return exp +} + +func REP(str) +{ + return PRINT(EVAL(READ(str), "")) +} + +func main(void) +{ + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) write, format="%s\n", REP(line) + } + write, "" +} + +main; diff --git a/yorick/step1_read_print.i b/yorick/step1_read_print.i new file mode 100644 index 0000000000..8a97cb8cf1 --- /dev/null +++ b/yorick/step1_read_print.i @@ -0,0 +1,43 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" + +func READ(str) +{ + return read_str(str) +} + +func EVAL(exp, env) +{ + if (structof(exp) == MalError) return exp + return exp +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func REP(str) +{ + return PRINT(EVAL(READ(str), "")) +} + +func main(void) +{ + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step2_eval.i b/yorick/step2_eval.i new file mode 100644 index 0000000000..2e59df84ca --- /dev/null +++ b/yorick/step2_eval.i @@ -0,0 +1,96 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + val = h_get(env, ast.val) + if (is_void(val)) return MalError(message=("'" + ast.val + "' not found")) + return val + } else if (type == MalList) { + seq = *(ast.val) + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + if (numberof(*ast.val) == 0) return ast + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = h_new() + h_set, repl_env, "+", MalNativeFunction(val="+") + h_set, repl_env, "-", MalNativeFunction(val="-") + h_set, repl_env, "*", MalNativeFunction(val="*") + h_set, repl_env, "/", MalNativeFunction(val="/") + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step3_env.i b/yorick/step3_env.i new file mode 100644 index 0000000000..4cb21e5ff6 --- /dev/null +++ b/yorick/step3_env.i @@ -0,0 +1,113 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + return EVAL(*lst(3), let_env) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = env_new(pointer(0)) + env_set, repl_env, "+", MalNativeFunction(val="+") + env_set, repl_env, "-", MalNativeFunction(val="-") + env_set, repl_env, "*", MalNativeFunction(val="*") + env_set, repl_env, "/", MalNativeFunction(val="/") + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step4_if_fn_do.i b/yorick/step4_if_fn_do.i new file mode 100644 index 0000000000..34308be913 --- /dev/null +++ b/yorick/step4_if_fn_do.i @@ -0,0 +1,155 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + return EVAL(*lst(3), let_env) + } else if (a1 == "do") { + ret = nil + for (i = 2; i <= numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + return ret + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + return EVAL(*lst(4), env) + } else { + return MAL_NIL + } + } else { + return EVAL(*lst(3), env) + } + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + return EVAL(*fn.ast, fn_env) + } else { + return MalError(message="Unknown function type") + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step5_tco.i b/yorick/step5_tco.i new file mode 100644 index 0000000000..4005b03123 --- /dev/null +++ b/yorick/step5_tco.i @@ -0,0 +1,162 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + while (1) { + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func main(void) +{ + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step6_file.i b/yorick/step6_file.i new file mode 100644 index 0000000000..70dfe901fc --- /dev/null +++ b/yorick/step6_file.i @@ -0,0 +1,190 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + while (1) { + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step7_quote.i b/yorick/step7_quote.i new file mode 100644 index 0000000000..bf9cbd1aad --- /dev/null +++ b/yorick/step7_quote.i @@ -0,0 +1,215 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func is_pair(ast) +{ + type = structof(ast) + return ((type == MalList) || (type == MalVector)) && count(ast) > 0 +} + +func quasiquote(ast) +{ + if (!is_pair(ast)) return MalList(val=&[&MalSymbol(val="quote"), &ast]) + lst = *ast.val + ast1 = *lst(1) + if (structof(ast1) == MalSymbol && ast1.val == "unquote") return *lst(2) + if (is_pair(ast1)) { + ast11 = *((*ast1.val)(1)) + if (structof(ast11) == MalSymbol && ast11.val == "splice-unquote") { + return MalList(val=&[&MalSymbol(val="concat"), (*ast1.val)(2), &quasiquote(rest(ast))]) + } + } + return MalList(val=&[&MalSymbol(val="cons"), &quasiquote(ast1), &quasiquote(rest(ast))]) +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + while (1) { + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step8_macros.i b/yorick/step8_macros.i new file mode 100644 index 0000000000..c5c5fb840f --- /dev/null +++ b/yorick/step8_macros.i @@ -0,0 +1,251 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func is_pair(ast) +{ + type = structof(ast) + return ((type == MalList) || (type == MalVector)) && count(ast) > 0 +} + +func quasiquote(ast) +{ + if (!is_pair(ast)) return MalList(val=&[&MalSymbol(val="quote"), &ast]) + lst = *ast.val + ast1 = *lst(1) + if (structof(ast1) == MalSymbol && ast1.val == "unquote") return *lst(2) + if (is_pair(ast1)) { + ast11 = *((*ast1.val)(1)) + if (structof(ast11) == MalSymbol && ast11.val == "splice-unquote") { + return MalList(val=&[&MalSymbol(val="concat"), (*ast1.val)(2), &quasiquote(rest(ast))]) + } + } + return MalList(val=&[&MalSymbol(val="cons"), &quasiquote(ast1), &quasiquote(rest(ast))]) +} + +func is_macro_call(ast, env) +{ + if (structof(ast) != MalList) return 0 + if (count(ast) == 0) return 0 + a1 = *((*ast.val)(1)) + if (structof(a1) != MalSymbol) return 0 + var_name = a1.val + found_env = env_find(env, var_name) + if (is_void(found_env)) return 0 + obj = env_get(env, var_name) + return is_macro(obj) +} + +func macroexpand(ast, env) +{ + while (is_macro_call(ast, env)) { + macro_name = (*ast.val)(1)->val + macro_obj = env_get(env, macro_name) + macro_args = *rest(ast).val + fn_env = env_new(macro_obj.env, binds=*macro_obj.binds, exprs=macro_args) + ast = EVAL(*macro_obj.ast, fn_env) + } + return ast +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + while (1) { + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + ast = macroexpand(ast, env) + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "defmacro!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + new_value.macro = 1 + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "macroexpand") { + return macroexpand(*lst(2), env) + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env + RE, "(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)))))))", repl_env + RE, "(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))))))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/step9_try.i b/yorick/step9_try.i new file mode 100644 index 0000000000..a4434974ea --- /dev/null +++ b/yorick/step9_try.i @@ -0,0 +1,265 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func is_pair(ast) +{ + type = structof(ast) + return ((type == MalList) || (type == MalVector)) && count(ast) > 0 +} + +func quasiquote(ast) +{ + if (!is_pair(ast)) return MalList(val=&[&MalSymbol(val="quote"), &ast]) + lst = *ast.val + ast1 = *lst(1) + if (structof(ast1) == MalSymbol && ast1.val == "unquote") return *lst(2) + if (is_pair(ast1)) { + ast11 = *((*ast1.val)(1)) + if (structof(ast11) == MalSymbol && ast11.val == "splice-unquote") { + return MalList(val=&[&MalSymbol(val="concat"), (*ast1.val)(2), &quasiquote(rest(ast))]) + } + } + return MalList(val=&[&MalSymbol(val="cons"), &quasiquote(ast1), &quasiquote(rest(ast))]) +} + +func is_macro_call(ast, env) +{ + if (structof(ast) != MalList) return 0 + if (count(ast) == 0) return 0 + a1 = *((*ast.val)(1)) + if (structof(a1) != MalSymbol) return 0 + var_name = a1.val + found_env = env_find(env, var_name) + if (is_void(found_env)) return 0 + obj = env_get(env, var_name) + return is_macro(obj) +} + +func macroexpand(ast, env) +{ + while (is_macro_call(ast, env)) { + macro_name = (*ast.val)(1)->val + macro_obj = env_get(env, macro_name) + macro_args = *rest(ast).val + fn_env = env_new(macro_obj.env, binds=*macro_obj.binds, exprs=macro_args) + ast = EVAL(*macro_obj.ast, fn_env) + } + return ast +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + while (1) { + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + ast = macroexpand(ast, env) + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "defmacro!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + new_value.macro = 1 + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "macroexpand") { + return macroexpand(*lst(2), env) + } else if (a1 == "try*") { + ret = EVAL(*lst(2), env) + if (structof(ret) == MalError) { + exc = *ret.obj + if (is_void(exc)) { + exc = MalString(val=ret.message) + } + catch_lst = *(lst(3)->val) + catch_env = env_new(&env) + env_set, catch_env, catch_lst(2)->val, exc + return EVAL(*catch_lst(3), catch_env) + } else { + return ret + } + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil + +func main(void) +{ + extern repl_env + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env + RE, "(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)))))))", repl_env + RE, "(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))))))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + stdin_file = open("/dev/stdin", "r") + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/stepA_mal.i b/yorick/stepA_mal.i new file mode 100644 index 0000000000..53829636dc --- /dev/null +++ b/yorick/stepA_mal.i @@ -0,0 +1,270 @@ +set_path, get_env("YORICK_MAL_PATH") + ":" + get_path() +require, "reader.i" +require, "printer.i" +require, "core.i" +require, "env.i" + +func READ(str) +{ + return read_str(str) +} + +func is_pair(ast) +{ + type = structof(ast) + return ((type == MalList) || (type == MalVector)) && count(ast) > 0 +} + +func quasiquote(ast) +{ + if (!is_pair(ast)) return MalList(val=&[&MalSymbol(val="quote"), &ast]) + lst = *ast.val + ast1 = *lst(1) + if (structof(ast1) == MalSymbol && ast1.val == "unquote") return *lst(2) + if (is_pair(ast1)) { + ast11 = *((*ast1.val)(1)) + if (structof(ast11) == MalSymbol && ast11.val == "splice-unquote") { + return MalList(val=&[&MalSymbol(val="concat"), (*ast1.val)(2), &quasiquote(rest(ast))]) + } + } + return MalList(val=&[&MalSymbol(val="cons"), &quasiquote(ast1), &quasiquote(rest(ast))]) +} + +func is_macro_call(ast, env) +{ + if (structof(ast) != MalList) return 0 + if (count(ast) == 0) return 0 + a1 = *((*ast.val)(1)) + if (structof(a1) != MalSymbol) return 0 + var_name = a1.val + found_env = env_find(env, var_name) + if (is_void(found_env)) return 0 + obj = env_get(env, var_name) + return is_macro(obj) +} + +func macroexpand(ast, env) +{ + while (is_macro_call(ast, env)) { + macro_name = (*ast.val)(1)->val + macro_obj = env_get(env, macro_name) + macro_args = *rest(ast).val + fn_env = env_new(macro_obj.env, binds=*macro_obj.binds, exprs=macro_args) + ast = EVAL(*macro_obj.ast, fn_env) + } + return ast +} + +func eval_ast(ast, env) +{ + type = structof(ast) + if (type == MalSymbol) { + return env_get(env, ast.val) + } else if (type == MalList) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalList(val=&res) + } else if (type == MalVector) { + seq = *(ast.val) + if (numberof(seq) == 0) return ast + res = array(pointer, numberof(seq)) + for (i = 1; i <= numberof(seq); ++i) { + e = EVAL(*seq(i), env) + if (structof(e) == MalError) return e + res(i) = &e + } + return MalVector(val=&res) + } else if (type == MalHashmap) { + h = *(ast.val) + if (numberof(*h.keys) == 0) return ast + res = hash_new() + for (i = 1; i <= numberof(*h.keys); ++i) { + new_key = EVAL(hashmap_key_to_obj((*h.keys)(i)), env) + if (structof(new_key) == MalError) return new_key + new_val = EVAL(*((*h.vals)(i)), env) + if (structof(new_val) == MalError) return new_val + hash_set, res, hashmap_obj_to_key(new_key), new_val + } + return MalHashmap(val=&res) + } else return ast +} + +func EVAL(ast, env) +{ + while (1) { + if (structof(ast) == MalError) return ast + if (structof(ast) != MalList) return eval_ast(ast, env) + ast = macroexpand(ast, env) + if (structof(ast) != MalList) return eval_ast(ast, env) + lst = *ast.val + if (numberof(lst) == 0) return ast + a1 = lst(1)->val + if (a1 == "def!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "let*") { + let_env = env_new(&env) + args_lst = *(lst(2)->val) + for (i = 1; i <= numberof(args_lst); i += 2) { + var_name = args_lst(i)->val + var_value = EVAL(*args_lst(i + 1), let_env) + if (structof(var_value) == MalError) return var_value + env_set, let_env, var_name, var_value + } + ast = *lst(3) + env = let_env + // TCO + } else if (a1 == "quote") { + return *lst(2) + } else if (a1 == "quasiquote") { + ast = quasiquote(*lst(2)) // TCO + } else if (a1 == "defmacro!") { + new_value = EVAL(*lst(3), env) + if (structof(new_value) == MalError) return new_value + new_value.macro = 1 + return env_set(env, lst(2)->val, new_value) + } else if (a1 == "macroexpand") { + return macroexpand(*lst(2), env) + } else if (a1 == "try*") { + ret = EVAL(*lst(2), env) + if (structof(ret) == MalError) { + exc = *ret.obj + if (is_void(exc)) { + exc = MalString(val=ret.message) + } + catch_lst = *(lst(3)->val) + catch_env = env_new(&env) + env_set, catch_env, catch_lst(2)->val, exc + return EVAL(*catch_lst(3), catch_env) + } else { + return ret + } + } else if (a1 == "do") { + for (i = 2; i < numberof(lst); ++i) { + ret = EVAL(*lst(i), env) + if (structof(ret) == MalError) return ret + } + ast = *lst(numberof(lst)) + // TCO + } else if (a1 == "if") { + cond_val = EVAL(*lst(2), env) + if (structof(cond_val) == MalError) return cond_val + if ((structof(cond_val) == MalNil) || (structof(cond_val) == MalFalse)) { + if (numberof(lst) > 3) { + ast = *lst(4) + } else { + return MAL_NIL + } + } else { + ast = *lst(3) + } + // TCO + } else if (a1 == "fn*") { + return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) + } else { + el = eval_ast(ast, env) + if (structof(el) == MalError) return el + seq = *el.val + if (structof(*seq(1)) == MalNativeFunction) { + args = (numberof(seq) > 1) ? seq(2:) : [] + return call_core_fn(seq(1)->val, args) + } else if (structof(*seq(1)) == MalFunction) { + fn = *seq(1) + exprs = numberof(seq) > 1 ? seq(2:) : [] + fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + ast = *fn.ast + env = fn_env + // TCO + } else { + return MalError(message="Unknown function type") + } + } + } +} + +func PRINT(exp) +{ + if (structof(exp) == MalError) return exp + return pr_str(exp, 1) +} + +func RE(str, env) +{ + return EVAL(READ(str), env) +} + +func REP(str, env) +{ + return PRINT(EVAL(READ(str), env)) +} + +func get_command_line(void) +// Force quiet mode (-q) to prevent Yorick from printing its banner +{ + argv = get_argv() + return numberof(argv) > 1 ? grow([argv(1), "-q"], argv(2:)) : [argv(1), "-q"] +} + +func prepare_argv_list(args) +{ + if (numberof(args) <= 1) return MalList(val=&[]) + str_lst = array(pointer, numberof(args) - 1) + for (i = 2; i <= numberof(args); ++i) { + str_lst(i - 1) = &MalString(val=args(i)) + } + return MalList(val=&str_lst) +} + +repl_env = nil +stdin_file = open("/dev/stdin", "r") + +func main(void) +{ + extern repl_env + extern stdin_file + repl_env = env_new(pointer(0)) + + // core.i: defined using Yorick + core_symbols = h_keys(core_ns) + for (i = 1; i <= numberof(core_symbols); ++i) { + env_set, repl_env, core_symbols(i), MalNativeFunction(val=core_symbols(i)) + } + command_line_args = process_argv() + env_set, repl_env, "*ARGV*", prepare_argv_list(command_line_args) + + // core.mal: defined using the language itself + RE, "(def! *host-language* \"yorick\")", repl_env + RE, "(def! not (fn* (a) (if a false true)))", repl_env + RE, "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env + RE, "(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)))))))", repl_env + RE, "(def! *gensym-counter* (atom 0))", repl_env + RE, "(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env + RE, "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))", repl_env + + if (numberof(command_line_args) > 0) { + RE, "(load-file \"" + command_line_args(1) + "\")", repl_env + return 0 + } + + RE, "(println (str \"Mal [\" *host-language* \"]\"))", repl_env + while (1) { + write, format="%s", "user> " + line = rdline(stdin_file, prompt="") + if (!line) break + if (strlen(line) > 0) { + result = REP(line, repl_env) + if (structof(result) == MalError) write, format="Error: %s\n", result.message + else write, format="%s\n", result + } + } + write, "" +} + +main; diff --git a/yorick/types.i b/yorick/types.i new file mode 100644 index 0000000000..a171e31dd1 --- /dev/null +++ b/yorick/types.i @@ -0,0 +1,166 @@ +require, "hash.i" + +struct MalError { + string message + pointer obj +} + +struct MalNil { + int val +} + +MAL_NIL = MalNil() + +struct MalTrue { + int val +} + +MAL_TRUE = MalTrue() + +struct MalFalse { + int val +} + +MAL_FALSE = MalFalse() + +struct MalNumber { + int val +} + +func new_number(s) +{ + return MalNumber(val=atoi(s)) +} + +struct MalSymbol { + string val + pointer meta +} + +struct MalString { + string val + pointer meta +} + +struct MalKeyword { + string val + pointer meta +} + +struct MalList { + pointer val + pointer meta +} + +struct MalVector { + pointer val + pointer meta +} + +func count(obj) { return numberof(*obj.val); } + +func rest(obj) { + seq = count(obj) <= 1 ? [] : ((*obj.val)(2:)) + return MalList(val=&seq) +} + +struct MalHashmap { + pointer val + pointer meta +} + +func hashmap_obj_to_key(obj) { + if (structof(obj) == MalString) return "str:" + obj.val + else if (structof(obj) == MalSymbol) return "sym:" + obj.val + else if (structof(obj) == MalKeyword) return "key:" + obj.val + else error, "Unsupported obj type for hash key" +} + +func hashmap_key_to_obj(key) { + type_str = strpart(key, 1:4) + val = strpart(key, 5:) + if (type_str == "str:") return MalString(val=val) + else if (type_str == "sym:") return MalSymbol(val=val) + else if (type_str == "key:") return MalKeyword(val=val) + else error, "Unsupported key type" +} + +func array_to_hashmap(seq) +{ + if (numberof(seq) % 2 != 0) return MalError(message="Odd number of elements in hashmap") + h = hash_new() + for (i = 1; i <= numberof(seq); i += 2) { + hash_set, h, hashmap_obj_to_key(*seq(i)), *seq(i + 1) + } + return MalHashmap(val=&h) +} + +struct MalNativeFunction { + string val + pointer meta +} + +struct MalFunction { + pointer env + pointer binds + pointer ast + int macro + pointer meta +} + +struct MalAtom { + pointer val + pointer meta +} + +func is_macro(obj) { return (structof(obj) == MalFunction && obj.macro); } + +struct MalAtomVal { + pointer val +} + +func new_boolean(b) { + if (b) return MAL_TRUE + return MAL_FALSE +} + +func equal_seq(seq_a, seq_b) { + if (numberof(seq_a) != numberof(seq_b)) return 0 + for (i = 1; i <= numberof(seq_a); ++i) { + if (!equal(*seq_a(i), *seq_b(i))) return 0 + } + return 1 +} + +func equal_hash(hm_a, hm_b) { + if (numberof(*hm_a.keys) != numberof(*hm_b.keys)) return 0 + for (i = 1; i <= numberof(*hm_a.keys); ++i) { + key_a = (*hm_a.keys)(i) + val_a = *((*hm_a.vals)(i)) + val_b = hash_get(hm_b, key_a) + if (is_void(val_b) || !equal(val_a, val_b)) return 0 + } + return 1 +} + +func equal(a, b) { + ta = structof(a) + tb = structof(b) + if (ta == MalNil) return tb == MalNil + else if (ta == MalTrue) return tb == MalTrue + else if (ta == MalFalse) return tb == MalFalse + else if (ta == MalNumber) return tb == MalNumber && a.val == b.val + else if (ta == MalSymbol) return tb == MalSymbol && a.val == b.val + else if (ta == MalString) return tb == MalString && a.val == b.val + else if (ta == MalKeyword) return tb == MalKeyword && a.val == b.val + else if (ta == MalList || ta == MalVector) { + return (tb == MalList || tb == MalVector) && equal_seq(*(a.val), *(b.val)) + } + else if (ta == MalHashmap) return tb == MalHashmap && equal_hash(*a.val, *b.val) + else return 0 +} + +func streplaceall(s, pattern, subst) +{ + return streplace(s, strfind(pattern, s, n=999), subst) +}