guile haskell haxe hy io java js julia kotlin livescript logo lua make mal \
matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp plpgsql \
plsql powershell ps python r racket rexx rpython ruby rust scala scheme skew \
- swift swift3 swift4 tcl ts vb vhdl vimscript wasm yorick
+ swift swift3 swift4 tcl ts vala vb vhdl vimscript wasm yorick
EXTENSION = .mal
swift4_STEP_TO_PROG = swift4/$($(1))
tcl_STEP_TO_PROG = tcl/$($(1)).tcl
ts_STEP_TO_PROG = ts/$($(1)).js
+vala_STEP_TO_PROG = vala/$($(1))
vb_STEP_TO_PROG = vb/$($(1)).exe
vhdl_STEP_TO_PROG = vhdl/$($(1))
vimscript_STEP_TO_PROG = vimscript/$($(1)).vim
| [Swift 4](#swift-4) | [陆遥](https://github.com/LispLY) |
| [Tcl](#tcl-86) | [Dov Murik](https://github.com/dubek) |
| [TypeScript](#typescript) | [Masahiro Wakame](https://github.com/vvakame) |
+| [Vala](#vala) | [Simon Tatham](https://github.com/sgtatham) |
| [VHDL](#vhdl) | [Dov Murik](https://github.com/dubek) |
| [Vimscript](#vimscript) | [Dov Murik](https://github.com/dubek) |
| [Visual Basic.NET](#visual-basicnet) | [Joel Martin](https://github.com/kanaka) |
node ./stepX_YYY.js
```
+### Vala
+
+The Vala implementation of mal has been tested with the Vala 0.40.8
+compiler. You will need to install `valac` and `libreadline-dev` or
+equivalent.
+
+```
+cd vala
+make
+./stepX_YYY
+```
+
### VHDL
The VHDL implementation of mal has been tested with GHDL 0.29.
--- /dev/null
+*.c
+*.h
+*.o
--- /dev/null
+FROM ubuntu:18.04
+
+RUN apt-get -y update
+RUN apt-get -y install git python make valac libreadline-dev
+
+WORKDIR /mal
--- /dev/null
+PROGRAMS = step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
+ step5_tco step6_file step7_quote step8_macros step9_try stepA_mal
+AUX1 = types.vala reader.vala printer.vala
+AUX3 = $(AUX1) env.vala
+AUX4 = $(AUX3) core.vala
+
+all: $(PROGRAMS)
+
+$(PROGRAMS): %: %.vala
+ valac -o $@ $^ $(DEFINES) --pkg readline -X -lreadline
+
+step1_read_print step2_eval: override DEFINES += -D NO_ENV
+
+step0_repl:
+step1_read_print: $(AUX1)
+step2_eval: $(AUX1)
+step3_env: $(AUX3)
+step4_if_fn_do: $(AUX4)
+step5_tco: $(AUX4)
+step6_file: $(AUX4)
+step7_quote: $(AUX4)
+step8_macros: $(AUX4)
+step9_try: $(AUX4)
+stepA_mal: $(AUX4)
+
+clean: clean-c
+ rm -f $(PROGRAMS)
+
+clean-c:
+ rm -f *.c *.h
--- /dev/null
+# Vala implementation
+
+Notes on building:
+
+* With the Debian or Ubuntu packages `valac` and `libreadline-dev`
+ installed, and GNU make, you should be able to build using the
+ provided Makefile.
+
+* The build will not be warning-clean, because the shared modules like
+ `types.vala` and `core.vala` are shared between all the `stepN` main
+ programs, and not all the steps use all the functions in the shared
+ modules, and the Vala compiler has no way to turn off the warning
+ about unused pieces of source code.
+
+* The Vala compiler works by translating the program to C and then
+ compiling that. The C compilation stage can sometimes encounter an
+ error, in which case the compiler will leave `.c` source files in
+ the working directory. If that happens, you can run `make clean-c`
+ to get rid of them.
+
+Design notes on the implementation:
+
+* Vala has a reference counting system built in to the language.
+ Garbage collection of mal objects is delegated to that system. So
+ you can almost certainly contrive an un-GC-able cycle of objects by
+ using atoms, and I haven't done anything about that.
+
+* Vala has exceptions (which it calls 'error domains'), but they don't
+ let you store an arbitrary data type: every exception subclass you
+ make stores the same data, namely a string. So mal exceptions are
+ implemented by storing a mal value in a static variable, and then
+ throwing a particular Vala error whose semantics are 'check that
+ variable when you catch me'.
+
+* Vala's bare function pointers are hard to use, especially if you
+ want one to survive the scope it was created in. So all the core
+ functions are implemented as classes with a `call` method, which
+ leads to a lot of boilerplate.
+
+* To make `types.vala` work in step 2, when the `Env` type doesn't
+ exist yet, I had to use `#if` to condition out the parts of the code
+ that depend on that type.
+
+* Mutability of objects at the Vala level is a bit informal. A lot of
+ core functions construct a list by making an empty `Mal.List` and
+ then mutating the `GLib.List` contained in it. But once they've
+ finished and returned the `Mal.List` to their caller, that list is
+ never mutated again, which means it's safe for the copying operation
+ in `with-meta` to make a second `Mal.List` sharing the reference to
+ the same `GLib.List`.
--- /dev/null
+abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction {
+ public abstract int64 result(int64 a, int64 b);
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ Mal.Num a = args.vs.data as Mal.Num;
+ Mal.Num b = args.vs.next.data as Mal.Num;
+ if (a == null || b == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ return new Mal.Num(result(a.v, b.v));
+ }
+}
+
+class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionAdd();
+ }
+ public override string name() { return "+"; }
+ public override int64 result(int64 a, int64 b) { return a+b; }
+}
+
+class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSub();
+ }
+ public override string name() { return "-"; }
+ public override int64 result(int64 a, int64 b) { return a-b; }
+}
+
+class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionMul();
+ }
+ public override string name() { return "*"; }
+ public override int64 result(int64 a, int64 b) { return a*b; }
+}
+
+class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionDiv();
+ }
+ public override string name() { return "/"; }
+ public override int64 result(int64 a, int64 b) { return a/b; }
+}
+
+class Mal.BuiltinFunctionPrStr : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionPrStr();
+ }
+ public override string name() { return "pr-str"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ string result = "";
+ string sep = "";
+ foreach (var value in args.vs) {
+ result += sep + pr_str(value, true);
+ sep = " ";
+ }
+ return new Mal.String(result);
+ }
+}
+
+class Mal.BuiltinFunctionStr : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionStr();
+ }
+ public override string name() { return "str"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ string result = "";
+ foreach (var value in args.vs) {
+ result += pr_str(value, false);
+ }
+ return new Mal.String(result);
+ }
+}
+
+class Mal.BuiltinFunctionPrn : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionPrn();
+ }
+ public override string name() { return "prn"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ string sep = "";
+ foreach (var value in args.vs) {
+ stdout.printf("%s%s", sep, pr_str(value, true));
+ sep = " ";
+ }
+ stdout.printf("\n");
+ return new Mal.Nil();
+ }
+}
+
+class Mal.BuiltinFunctionPrintln : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionPrintln();
+ }
+ public override string name() { return "println"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ string sep = "";
+ foreach (var value in args.vs) {
+ stdout.printf("%s%s", sep, pr_str(value, false));
+ sep = " ";
+ }
+ stdout.printf("\n");
+ return new Mal.Nil();
+ }
+}
+
+class Mal.BuiltinFunctionReadString : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionReadString();
+ }
+ public override string name() { return "read-string"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1 || !(args.vs.data is Mal.String))
+ throw new Mal.Error.BAD_PARAMS("%s: expected one string", name());
+ return Reader.read_str((args.vs.data as Mal.String).v);
+ }
+}
+
+class Mal.BuiltinFunctionSlurp : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSlurp();
+ }
+ public override string name() { return "slurp"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1 || !(args.vs.data is Mal.String))
+ throw new Mal.Error.BAD_PARAMS("%s: expected one string", name());
+ string filename = (args.vs.data as Mal.String).v;
+ string contents;
+ try {
+ FileUtils.get_contents(filename, out contents);
+ } catch (FileError e) {
+ throw new Mal.Error.BAD_PARAMS("%s: unable to read '%s': %s",
+ name(), filename, e.message);
+ }
+ return new Mal.String(contents);
+ }
+}
+
+class Mal.BuiltinFunctionList : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionList();
+ }
+ public override string name() { return "list"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ return args;
+ }
+}
+
+class Mal.BuiltinFunctionListP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionListP();
+ }
+ public override string name() { return "list?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.List);
+ }
+}
+
+class Mal.BuiltinFunctionSequentialP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSequentialP();
+ }
+ public override string name() { return "sequential?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.List ||
+ args.vs.data is Mal.Vector);
+ }
+}
+
+class Mal.BuiltinFunctionNilP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionNilP();
+ }
+ public override string name() { return "nil?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Nil);
+ }
+}
+
+class Mal.BuiltinFunctionTrueP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionTrueP();
+ }
+ public override string name() { return "true?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Bool &&
+ (args.vs.data as Mal.Bool).v);
+ }
+}
+
+class Mal.BuiltinFunctionFalseP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionFalseP();
+ }
+ public override string name() { return "false?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Bool &&
+ !(args.vs.data as Mal.Bool).v);
+ }
+}
+
+class Mal.BuiltinFunctionNumberP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionNumberP();
+ }
+ public override string name() { return "number?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Num);
+ }
+}
+
+class Mal.BuiltinFunctionStringP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionStringP();
+ }
+ public override string name() { return "string?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.String);
+ }
+}
+
+class Mal.BuiltinFunctionSymbolP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSymbolP();
+ }
+ public override string name() { return "symbol?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Sym);
+ }
+}
+
+class Mal.BuiltinFunctionKeywordP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionKeywordP();
+ }
+ public override string name() { return "keyword?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Keyword);
+ }
+}
+
+class Mal.BuiltinFunctionVector : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionVector();
+ }
+ public override string name() { return "vector"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ return new Mal.Vector.from_list(args.vs);
+ }
+}
+
+class Mal.BuiltinFunctionVectorP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionVectorP();
+ }
+ public override string name() { return "vector?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Vector);
+ }
+}
+
+class Mal.BuiltinFunctionHashMap : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionHashMap();
+ }
+ public override string name() { return "hash-map"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ var map = new Mal.Hashmap();
+ for (var iter = args.iter(); iter.nonempty(); iter.step()) {
+ var key = iter.deref();
+ var value = iter.step().deref();
+ if (value == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected an even number of arguments", name());
+ map.insert(key, value);
+ }
+ return map;
+ }
+}
+
+class Mal.BuiltinFunctionMapP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionMapP();
+ }
+ public override string name() { return "map?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Hashmap);
+ }
+}
+
+class Mal.BuiltinFunctionEmptyP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionEmptyP();
+ }
+ public override string name() { return "empty?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ var list = args.vs.data as Mal.Listlike;
+ if (list == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a list-like argument", name());
+ return new Mal.Bool(list.iter().deref() == null);
+ }
+}
+
+class Mal.BuiltinFunctionFnP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionFnP();
+ }
+ public override string name() { return "fn?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ if (args.vs.data is Mal.BuiltinFunction)
+ return new Mal.Bool(true);
+ var fn = args.vs.data as Mal.Function;
+ return new Mal.Bool(fn != null && !fn.is_macro);
+ }
+}
+
+class Mal.BuiltinFunctionMacroP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionMacroP();
+ }
+ public override string name() { return "macro?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ var fn = args.vs.data as Mal.Function;
+ return new Mal.Bool(fn != null && fn.is_macro);
+ }
+}
+
+class Mal.BuiltinFunctionCount : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionCount();
+ }
+ public override string name() { return "count"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ if (args.vs.data is Mal.Nil)
+ return new Mal.Num(0); // nil is treated like ()
+ if (args.vs.data is Mal.List)
+ return new Mal.Num((args.vs.data as Mal.List).vs.length());
+ if (args.vs.data is Mal.Vector)
+ return new Mal.Num((args.vs.data as Mal.Vector).vs.length);
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a list argument", name());
+ }
+}
+
+class Mal.BuiltinFunctionEQ : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionEQ();
+ }
+ public override string name() { return "="; }
+ private static bool eq(Mal.Val a, Mal.Val b) {
+ if (a is Mal.Nil && b is Mal.Nil)
+ return true;
+ if (a is Mal.Bool && b is Mal.Bool)
+ return (a as Mal.Bool).v == (b as Mal.Bool).v;
+ if (a is Mal.Sym && b is Mal.Sym)
+ return (a as Mal.Sym).v == (b as Mal.Sym).v;
+ if (a is Mal.Keyword && b is Mal.Keyword)
+ return (a as Mal.Keyword).v == (b as Mal.Keyword).v;
+ if (a is Mal.Num && b is Mal.Num)
+ return (a as Mal.Num).v == (b as Mal.Num).v;
+ if (a is Mal.String && b is Mal.String)
+ return (a as Mal.String).v == (b as Mal.String).v;
+ if (a is Mal.Listlike && b is Mal.Listlike) {
+ if (a is Mal.Nil || b is Mal.Nil)
+ return false;
+ var aiter = (a as Mal.Listlike).iter();
+ var biter = (b as Mal.Listlike).iter();
+ while (aiter.nonempty() || biter.nonempty()) {
+ if (aiter.empty() || biter.empty())
+ return false;
+ if (!eq(aiter.deref(), biter.deref()))
+ return false;
+ aiter.step();
+ biter.step();
+ }
+ return true;
+ }
+ if (a is Mal.Vector && b is Mal.Vector) {
+ var av = (a as Mal.Vector).vs;
+ var bv = (b as Mal.Vector).vs;
+ if (av.length != bv.length)
+ return false;
+ for (var i = 0; i < av.length; i++)
+ if (!eq(av[i], bv[i]))
+ return false;
+ return true;
+ }
+ if (a is Mal.Hashmap && b is Mal.Hashmap) {
+ var ah = (a as Mal.Hashmap).vs;
+ var bh = (b as Mal.Hashmap).vs;
+ if (ah.length != bh.length)
+ return false;
+ foreach (var k in ah.get_keys()) {
+ var av = ah[k];
+ var bv = bh[k];
+ if (bv == null || !eq(av, bv))
+ return false;
+ }
+ return true;
+ }
+ if (a is Mal.BuiltinFunction && b is Mal.BuiltinFunction) {
+ return ((a as Mal.BuiltinFunction).name() ==
+ (b as Mal.BuiltinFunction).name());
+ }
+ if (a is Mal.Function && b is Mal.Function) {
+ var af = a as Mal.Function;
+ var bf = b as Mal.Function;
+ return (eq(af.parameters, bf.parameters) &&
+ eq(af.body, bf.body));
+ }
+ return false;
+ }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ return new Mal.Bool(eq(args.vs.data, args.vs.next.data));
+ }
+}
+
+abstract class Mal.BuiltinFunctionNumberCmp : Mal.BuiltinFunction {
+ public abstract bool result(int64 a, int64 b);
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ Mal.Num a = args.vs.data as Mal.Num;
+ Mal.Num b = args.vs.next.data as Mal.Num;
+ if (a == null || b == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ return new Mal.Bool(result(a.v, b.v));
+ }
+}
+
+class Mal.BuiltinFunctionLT : Mal.BuiltinFunctionNumberCmp {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionLT();
+ }
+ public override string name() { return "<"; }
+ public override bool result(int64 a, int64 b) { return a<b; }
+}
+
+class Mal.BuiltinFunctionLE : Mal.BuiltinFunctionNumberCmp {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionLE();
+ }
+ public override string name() { return "<="; }
+ public override bool result(int64 a, int64 b) { return a<=b; }
+}
+
+class Mal.BuiltinFunctionGT : Mal.BuiltinFunctionNumberCmp {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionGT();
+ }
+ public override string name() { return ">"; }
+ public override bool result(int64 a, int64 b) { return a>b; }
+}
+
+class Mal.BuiltinFunctionGE : Mal.BuiltinFunctionNumberCmp {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionGE();
+ }
+ public override string name() { return ">="; }
+ public override bool result(int64 a, int64 b) { return a>=b; }
+}
+
+class Mal.BuiltinFunctionAtom : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionAtom();
+ }
+ public override string name() { return "atom"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Atom(args.vs.data);
+ }
+}
+
+class Mal.BuiltinFunctionAtomP : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionAtomP();
+ }
+ public override string name() { return "atom?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return new Mal.Bool(args.vs.data is Mal.Atom);
+ }
+}
+
+class Mal.BuiltinFunctionDeref : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionDeref();
+ }
+ public override string name() { return "deref"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ var atom = args.vs.data as Mal.Atom;
+ if (atom == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected an atom", name());
+ return atom.v;
+ }
+}
+
+class Mal.BuiltinFunctionReset : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionReset();
+ }
+ public override string name() { return "reset!"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ var atom = args.vs.data as Mal.Atom;
+ if (atom == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected an atom", name());
+ atom.v = args.vs.next.data;
+ return atom.v;
+ }
+}
+
+Mal.Val call_function(Mal.Val function, GLib.List<Mal.Val> args, string caller)
+throws Mal.Error {
+ var fnargs = new Mal.List(args);
+ if (function is Mal.BuiltinFunction) {
+ return (function as Mal.BuiltinFunction).call(fnargs);
+ } else if (function is Mal.Function) {
+ var fn = function as Mal.Function;
+ var env = new Mal.Env.funcall(fn.env, fn.parameters, fnargs);
+ return Mal.Main.EVAL(fn.body, env);
+ } else {
+ throw new Mal.Error.CANNOT_APPLY("%s: expected a function", caller);
+ }
+}
+
+class Mal.BuiltinFunctionSwap : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSwap();
+ }
+ public override string name() { return "swap!"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() < 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected at least two arguments", name());
+ var atom = args.vs.data as Mal.Atom;
+ var function = args.vs.next.data;
+ var fnargs = args.vs.next.next.copy();
+ fnargs.prepend(atom.v);
+ atom.v = call_function(function, fnargs, name());
+ return atom.v;
+ }
+}
+
+class Mal.BuiltinFunctionCons : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionCons();
+ }
+ public override string name() { return "cons"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ var first = args.vs.data;
+ var rest = args.vs.next.data as Mal.Listlike;
+ if (rest == null) {
+ if (args.vs.next.data is Mal.Nil)
+ rest = new Mal.List.empty();
+ else
+ throw new Mal.Error.BAD_PARAMS("%s: expected a list", name());
+ }
+ var newlist = new Mal.List.empty();
+ newlist.vs.append(first);
+ for (var iter = rest.iter(); iter.nonempty(); iter.step())
+ newlist.vs.append(iter.deref());
+ return newlist;
+ }
+}
+
+class Mal.BuiltinFunctionConcat : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionConcat();
+ }
+ public override string name() { return "concat"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ var newlist = new GLib.List<Mal.Val>();
+ foreach (var listval in args.vs) {
+ if (listval is Mal.Nil)
+ continue;
+ var list = listval as Mal.Listlike;
+ if (list == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected a list", name());
+ for (var iter = list.iter(); iter.nonempty(); iter.step())
+ newlist.append(iter.deref());
+ }
+ return new Mal.List(newlist);
+ }
+}
+
+class Mal.BuiltinFunctionNth : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionNth();
+ }
+ public override string name() { return "nth"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ var list = args.vs.data as Mal.Listlike;
+ var index = args.vs.next.data as Mal.Num;
+ if (list == null || index == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a list and a number", name());
+ if (index.v < 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: negative list index", name());
+ Mal.Val? result = null;
+ if (list is Mal.Vector) {
+ var vec = list as Mal.Vector;
+ if (index.v < vec.vs.length)
+ result = vec.vs[index.v];
+ } else {
+ var iter = list.iter();
+ var i = index.v;
+ while (!iter.empty()) {
+ if (i == 0) {
+ result = iter.deref();
+ break;
+ }
+ iter.step();
+ i--;
+ }
+ }
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: list index out of range", name());
+ return result;
+ }
+}
+
+class Mal.BuiltinFunctionFirst : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionFirst();
+ }
+ public override string name() { return "first"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ var list = args.vs.data as Mal.Listlike;
+ if (list == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a list number", name());
+ Mal.Val? result = list.iter().deref();
+ if (result == null)
+ result = new Mal.Nil();
+ return result;
+ }
+}
+
+class Mal.BuiltinFunctionRest : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionRest();
+ }
+ public override string name() { return "rest"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ var list = args.vs.data as Mal.Listlike;
+ if (list == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a list", name());
+ var result = new Mal.List.empty();
+ for (var iter = list.iter().step(); iter.nonempty(); iter.step())
+ result.vs.append(iter.deref());
+ return result;
+ }
+}
+
+class Mal.BuiltinFunctionThrow : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionThrow();
+ }
+ private static Mal.Val? curr_exception;
+ static construct {
+ curr_exception = null;
+ }
+ public static void clear() {
+ curr_exception = null;
+ }
+ public static Mal.Val thrown_value(Mal.Error err) {
+ if (err is Mal.Error.EXCEPTION_THROWN) {
+ assert(curr_exception != null);
+ Mal.Val toret = curr_exception;
+ curr_exception = null;
+ return toret;
+ } else {
+ return new Mal.String(err.message);
+ }
+ }
+
+ public override string name() { return "throw"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ assert(curr_exception == null);
+ curr_exception = args.vs.data;
+ throw new Mal.Error.EXCEPTION_THROWN("core function throw called");
+ }
+}
+
+class Mal.BuiltinFunctionApply : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionApply();
+ }
+ public override string name() { return "apply"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() < 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected at least two arguments", name());
+ var function = args.vs.data;
+ unowned GLib.List<Mal.Val> lastlink = args.vs.last();
+ var list = lastlink.data as Mal.Listlike;
+ if (list == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected final argument to be a list", name());
+ var fnargs = list.as_glib_list();
+ for (unowned GLib.List<Mal.Val> link = lastlink.prev;
+ link != args.vs; link = link.prev)
+ fnargs.prepend(link.data);
+ return call_function(function, fnargs, name());
+ }
+}
+
+class Mal.BuiltinFunctionMap : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionMap();
+ }
+ public override string name() { return "map"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ var function = args.vs.data;
+ var list = args.vs.next.data as Mal.Listlike;
+ if (list == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected a list", name());
+ var result = new Mal.List.empty();
+ for (var iter = list.iter(); iter.nonempty(); iter.step()) {
+ var fnargs = new GLib.List<Mal.Val>();
+ fnargs.append(iter.deref());
+ result.vs.append(call_function(function, fnargs, name()));
+ }
+ return result;
+ }
+}
+
+class Mal.BuiltinFunctionSymbol : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSymbol();
+ }
+ public override string name() { return "symbol"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1 || !(args.vs.data is Mal.String))
+ throw new Mal.Error.BAD_PARAMS("%s: expected one string", name());
+ return new Mal.Sym((args.vs.data as Mal.String).v);
+ }
+}
+
+class Mal.BuiltinFunctionKeyword : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionKeyword();
+ }
+ public override string name() { return "keyword"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1 || !(args.vs.data is Mal.String))
+ throw new Mal.Error.BAD_PARAMS("%s: expected one string", name());
+ return new Mal.Keyword((args.vs.data as Mal.String).v);
+ }
+}
+
+class Mal.BuiltinFunctionAssoc : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionAssoc();
+ }
+ public override string name() { return "assoc"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ var iter = args.iter();
+ var oldmap = iter.deref() as Mal.Hashmap;
+ if (iter.deref() is Mal.Nil)
+ oldmap = new Mal.Hashmap();
+ if (oldmap == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a hash-map to modify", name());
+
+ var map = new Mal.Hashmap();
+ foreach (var key in oldmap.vs.get_keys())
+ map.insert(key, oldmap.vs[key]);
+
+ for (iter.step(); iter.nonempty(); iter.step()) {
+ var key = iter.deref();
+ var value = iter.step().deref();
+ if (value == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected an even number of arguments", name());
+ map.insert(key, value);
+ }
+ return map;
+ }
+}
+
+class Mal.BuiltinFunctionDissoc : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionDissoc();
+ }
+ public override string name() { return "dissoc"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ var iter = args.iter();
+ var oldmap = iter.deref() as Mal.Hashmap;
+ if (iter.deref() is Mal.Nil)
+ oldmap = new Mal.Hashmap();
+ if (oldmap == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a hash-map to modify", name());
+
+ var map = new Mal.Hashmap();
+ foreach (var key in oldmap.vs.get_keys())
+ map.insert(key, oldmap.vs[key]);
+
+ for (iter.step(); iter.nonempty(); iter.step()) {
+ var key = iter.deref();
+ map.remove(key);
+ }
+ return map;
+ }
+}
+
+// Can't call it BuiltinFunctionGet, or else valac defines
+// BUILTIN_FUNCTION_GET_CLASS at the C level for this class, but that
+// was already defined as the 'get class' macro for BuiltinFunction
+// itself!
+class Mal.BuiltinFunctionGetFn : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionGetFn();
+ }
+ public override string name() { return "get"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ if (args.vs.data is Mal.Nil)
+ return new Mal.Nil();
+ var map = args.vs.data as Mal.Hashmap;
+ if (map == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a hash-map to query", name());
+ var key = args.vs.next.data as Mal.Hashable;
+ if (key == null)
+ throw new Mal.Error.HASH_KEY_TYPE_ERROR(
+ "%s: bad type as hash key", name());
+ var value = map.vs[key];
+ return value != null ? value : new Mal.Nil();
+ }
+}
+
+class Mal.BuiltinFunctionContains : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionContains();
+ }
+ public override string name() { return "contains?"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected two arguments", name());
+ if (args.vs.data is Mal.Nil)
+ return new Mal.Bool(false);
+ var map = args.vs.data as Mal.Hashmap;
+ if (map == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a hash-map to query", name());
+ var key = args.vs.next.data as Mal.Hashable;
+ if (key == null)
+ throw new Mal.Error.HASH_KEY_TYPE_ERROR(
+ "%s: bad type as hash key", name());
+ var value = map.vs[key];
+ return new Mal.Bool(value != null);
+ }
+}
+
+class Mal.BuiltinFunctionKeys : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionKeys();
+ }
+ public override string name() { return "keys"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected one argument", name());
+ var keys = new Mal.List.empty();
+ if (args.vs.data is Mal.Nil)
+ return keys;
+ var map = args.vs.data as Mal.Hashmap;
+ if (map == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a hash-map to query", name());
+ foreach (var key in map.vs.get_keys())
+ keys.vs.append(key);
+ return keys;
+ }
+}
+
+class Mal.BuiltinFunctionVals : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionVals();
+ }
+ public override string name() { return "vals"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected one argument", name());
+ var vals = new Mal.List.empty();
+ if (args.vs.data is Mal.Nil)
+ return vals;
+ var map = args.vs.data as Mal.Hashmap;
+ if (map == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a hash-map to query", name());
+ foreach (var key in map.vs.get_keys())
+ vals.vs.append(map.vs[key]);
+ return vals;
+ }
+}
+
+class Mal.BuiltinFunctionReadline : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionReadline();
+ }
+ public override string name() { return "readline"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected one argument", name());
+ string prompt = "";
+ if (args.vs.data is Mal.String)
+ prompt = (args.vs.data as Mal.String).v;
+ else if (!(args.vs.data is Mal.Nil))
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a string prompt", name());
+ string? line = Readline.readline(prompt);
+ if (line == null)
+ return new Mal.Nil();
+ return new Mal.String(line);
+ }
+}
+
+class Mal.BuiltinFunctionMeta : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionMeta();
+ }
+ public override string name() { return "meta"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected one argument", name());
+ var vwm = args.vs.data as Mal.ValWithMetadata;
+ if (vwm == null)
+ return new Mal.Nil();
+ return vwm.metadata;
+ }
+}
+
+class Mal.BuiltinFunctionWithMeta : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionWithMeta();
+ }
+ public override string name() { return "with-meta"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected one argument", name());
+ var vwm = args.vs.data as Mal.ValWithMetadata;
+ if (vwm == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: bad type for with-meta", name());
+ var copied = vwm.copy();
+ copied.metadata = args.vs.next.data;
+ return copied;
+ }
+}
+
+class Mal.BuiltinFunctionTimeMs : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionTimeMs();
+ }
+ public override string name() { return "time-ms"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected no arguments", name());
+ var time = GLib.TimeVal();
+ time.get_current_time();
+ return new Mal.Num(time.tv_sec * 1000 + time.tv_usec / 1000);
+ }
+}
+
+class Mal.BuiltinFunctionConj : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionConj();
+ }
+ public override string name() { return "conj"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ var iter = args.iter();
+ var collection = iter.deref() as Mal.Listlike;
+ if (collection == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected a collection to modify", name());
+
+ if (collection is Mal.Vector) {
+ var oldvec = collection as Mal.Vector;
+ var n = args.vs.length() - 1;
+ var newvec = new Mal.Vector.with_size(oldvec.vs.length + n);
+ int i;
+ for (i = 0; i < oldvec.vs.length; i++)
+ newvec.vs[i] = oldvec.vs[i];
+ for (iter.step(); iter.nonempty(); iter.step(), i++)
+ newvec.vs[i] = iter.deref();
+ return newvec;
+ } else {
+ var newlist = new Mal.List.empty();
+ for (var citer = collection.iter(); citer.nonempty(); citer.step())
+ newlist.vs.append(citer.deref());
+ for (iter.step(); iter.nonempty(); iter.step())
+ newlist.vs.prepend(iter.deref());
+ return newlist;
+ }
+ }
+}
+
+class Mal.BuiltinFunctionSeq : Mal.BuiltinFunction {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSeq();
+ }
+ public override string name() { return "seq"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS(
+ "%s: expected one argument", name());
+ Mal.List toret;
+ if (args.vs.data is Mal.List) {
+ toret = args.vs.data as Mal.List;
+ } else {
+ toret = new Mal.List.empty();
+ if (args.vs.data is Mal.String) {
+ var str = (args.vs.data as Mal.String).v;
+ if (str.length != 0) {
+ unowned string tail = str;
+ while (tail != "") {
+ unowned string new_tail = tail.next_char();
+ var ch = str.substring(str.length - tail.length,
+ tail.length - new_tail.length);
+ toret.vs.append(new Mal.String(ch));
+ tail = new_tail;
+ }
+ }
+ } else if (args.vs.data is Mal.Listlike) {
+ var collection = args.vs.data as Mal.Listlike;
+ for (var iter = collection.iter(); iter.nonempty(); iter.step())
+ toret.vs.append(iter.deref());
+ } else {
+ throw new Mal.Error.BAD_PARAMS("%s: bad input type", name());
+ }
+ }
+ if (toret.vs.length() == 0)
+ return new Mal.Nil();
+ return toret;
+ }
+}
+
+class Mal.Core {
+ public static GLib.HashTable<string, Mal.Val> ns;
+
+ private static void add_builtin(Mal.BuiltinFunction f) {
+ ns[f.name()] = f;
+ }
+
+ public static void make_ns() {
+ ns = new GLib.HashTable<string, Val>(str_hash, str_equal);
+ add_builtin(new BuiltinFunctionAdd());
+ add_builtin(new BuiltinFunctionSub());
+ add_builtin(new BuiltinFunctionMul());
+ add_builtin(new BuiltinFunctionDiv());
+ add_builtin(new BuiltinFunctionPrStr());
+ add_builtin(new BuiltinFunctionStr());
+ add_builtin(new BuiltinFunctionPrn());
+ add_builtin(new BuiltinFunctionPrintln());
+ add_builtin(new BuiltinFunctionReadString());
+ add_builtin(new BuiltinFunctionSlurp());
+ add_builtin(new BuiltinFunctionList());
+ add_builtin(new BuiltinFunctionListP());
+ add_builtin(new BuiltinFunctionNilP());
+ add_builtin(new BuiltinFunctionTrueP());
+ add_builtin(new BuiltinFunctionFalseP());
+ add_builtin(new BuiltinFunctionNumberP());
+ add_builtin(new BuiltinFunctionStringP());
+ add_builtin(new BuiltinFunctionSymbol());
+ add_builtin(new BuiltinFunctionSymbolP());
+ add_builtin(new BuiltinFunctionKeyword());
+ add_builtin(new BuiltinFunctionKeywordP());
+ add_builtin(new BuiltinFunctionVector());
+ add_builtin(new BuiltinFunctionVectorP());
+ add_builtin(new BuiltinFunctionSequentialP());
+ add_builtin(new BuiltinFunctionHashMap());
+ add_builtin(new BuiltinFunctionMapP());
+ add_builtin(new BuiltinFunctionEmptyP());
+ add_builtin(new BuiltinFunctionFnP());
+ add_builtin(new BuiltinFunctionMacroP());
+ add_builtin(new BuiltinFunctionCount());
+ add_builtin(new BuiltinFunctionEQ());
+ add_builtin(new BuiltinFunctionLT());
+ add_builtin(new BuiltinFunctionLE());
+ add_builtin(new BuiltinFunctionGT());
+ add_builtin(new BuiltinFunctionGE());
+ add_builtin(new BuiltinFunctionAtom());
+ add_builtin(new BuiltinFunctionAtomP());
+ add_builtin(new BuiltinFunctionDeref());
+ add_builtin(new BuiltinFunctionReset());
+ add_builtin(new BuiltinFunctionSwap());
+ add_builtin(new BuiltinFunctionCons());
+ add_builtin(new BuiltinFunctionConcat());
+ add_builtin(new BuiltinFunctionNth());
+ add_builtin(new BuiltinFunctionFirst());
+ add_builtin(new BuiltinFunctionRest());
+ add_builtin(new BuiltinFunctionThrow());
+ add_builtin(new BuiltinFunctionApply());
+ add_builtin(new BuiltinFunctionMap());
+ add_builtin(new BuiltinFunctionAssoc());
+ add_builtin(new BuiltinFunctionDissoc());
+ add_builtin(new BuiltinFunctionGetFn());
+ add_builtin(new BuiltinFunctionContains());
+ add_builtin(new BuiltinFunctionKeys());
+ add_builtin(new BuiltinFunctionVals());
+ add_builtin(new BuiltinFunctionReadline());
+ add_builtin(new BuiltinFunctionMeta());
+ add_builtin(new BuiltinFunctionWithMeta());
+ add_builtin(new BuiltinFunctionTimeMs());
+ add_builtin(new BuiltinFunctionConj());
+ add_builtin(new BuiltinFunctionSeq());
+ }
+}
--- /dev/null
+class Mal.Env : GLib.Object {
+ public GLib.HashTable<Mal.Sym, Mal.Val> data;
+ Mal.Env? outer;
+
+ construct {
+ data = new GLib.HashTable<Mal.Sym, Mal.Val>(
+ Mal.Hashable.hash, Mal.Hashable.equal);
+ }
+
+ public Env.within(Mal.Env outer_) {
+ outer = outer_;
+ }
+
+ public Env() {
+ outer = null;
+ }
+
+ public Env.funcall(Mal.Env outer_, Mal.Listlike binds, Mal.List exprs)
+ throws Mal.Error {
+ outer = outer_;
+ var binditer = binds.iter();
+ unowned GLib.List<Mal.Val> exprlist = exprs.vs;
+
+ while (binditer.nonempty()) {
+ var paramsym = binditer.deref() as Mal.Sym;
+ if (paramsym.v == "&") {
+ binditer.step();
+ var rest = binditer.deref();
+ binditer.step();
+ if (rest == null || binditer.nonempty())
+ throw new Mal.Error.BAD_PARAMS(
+ "expected exactly one parameter name after &");
+ set(rest as Mal.Sym, new Mal.List(exprlist.copy()));
+ return;
+ } else {
+ if (exprlist == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "too few arguments for function");
+ set(paramsym, exprlist.data);
+ binditer.step();
+ exprlist = exprlist.next;
+ }
+ }
+ if (exprlist != null)
+ throw new Mal.Error.BAD_PARAMS("too many arguments for function");
+ }
+
+ // Use the 'new' keyword to silence warnings about 'set' and 'get'
+ // already having meanings that we're overwriting
+ public new void set(Mal.Sym key, Mal.Val f) {
+ data[key] = f;
+ }
+
+ public Mal.Env? find(Mal.Sym key) {
+ if (key in data)
+ return this;
+ if (outer == null)
+ return null;
+ return outer.find(key);
+ }
+
+ public new Mal.Val get(Mal.Sym key) throws Mal.Error {
+ var found = find(key);
+ if (found == null)
+ throw new Error.ENV_LOOKUP_FAILED("'%s' not found", key.v);
+ return found.data[key];
+ }
+}
--- /dev/null
+namespace Mal {
+ string pr_str(Mal.Val val, bool print_readably = true) {
+ if (val is Mal.Nil)
+ return "nil";
+ if (val is Mal.Bool)
+ return (val as Mal.Bool).v ? "true" : "false";
+ if (val is Mal.Sym)
+ return (val as Mal.Sym).v;
+ if (val is Mal.Keyword)
+ return ":" + (val as Mal.Keyword).v;
+ if (val is Mal.Num)
+ return ("%"+int64.FORMAT_MODIFIER+"d")
+ .printf((val as Mal.Num).v);
+ if (val is Mal.String) {
+ string s = (val as Mal.String).v;
+ if (print_readably)
+ s = "\"%s\"".printf(s.replace("\\", "\\\\")
+ .replace("\n", "\\n").
+ replace("\"", "\\\""));
+ return s;
+ }
+ if (val is Mal.List) {
+ string toret = "(";
+ string sep = "";
+ foreach (var elt in (val as Mal.List).vs) {
+ toret += sep + pr_str(elt, print_readably);
+ sep = " ";
+ }
+ toret += ")";
+ return toret;
+ }
+ if (val is Mal.Vector) {
+ string toret = "[";
+ string sep = "";
+ foreach (var elt in (val as Mal.Vector).vs) {
+ toret += sep + pr_str(elt, print_readably);
+ sep = " ";
+ }
+ toret += "]";
+ return toret;
+ }
+ if (val is Mal.Hashmap) {
+ string toret = "{";
+ string sep = "";
+ var map = (val as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys()) {
+ toret += (sep + pr_str(key, print_readably) + " " +
+ pr_str(map[key], print_readably));
+ sep = " ";
+ }
+ toret += "}";
+ return toret;
+ }
+ if (val is Mal.BuiltinFunction) {
+ return "#<builtin:%s>".printf((val as Mal.BuiltinFunction).name());
+ }
+ if (val is Mal.Function) {
+ return "#<function>";
+ }
+ if (val is Mal.Atom) {
+ return "(atom %s)".printf(
+ pr_str((val as Mal.Atom).v, print_readably));
+ }
+ return "??";
+ }
+}
--- /dev/null
+class Mal.Reader : GLib.Object {
+ static Regex tok_re;
+ static Regex tok_num;
+
+ int origlen;
+ string data;
+ int pos;
+
+ string next_token;
+
+ static construct {
+ tok_re = /[\s,]*(~@|[\[\]{}()'`~^@]|"(?:\\.|[^\\"])*"?|;[^\n]*|[^\s\[\]{}('"`,;)]*)/; // comment to unconfuse emacs vala-mode "]);
+ tok_num = /^-?[0-9]/;
+ }
+
+ private string poserr(string fmt, ...) {
+ return "char %d: %s".printf(origlen - data.length,
+ fmt.vprintf(va_list()));
+ }
+
+ private void advance() throws Error {
+ do {
+ MatchInfo info;
+ if (!tok_re.match(data, 0, out info))
+ throw new Error.BAD_TOKEN(poserr("bad token"));
+
+ next_token = info.fetch(1);
+ int tokenend;
+ info.fetch_pos(1, null, out tokenend);
+ data = data[tokenend:data.length];
+ } while (next_token.has_prefix(";"));
+ }
+
+ public Reader(string str) throws Error {
+ data = str;
+ origlen = data.length;
+ pos = 0;
+ advance();
+ }
+
+ public string peek() throws Error {
+ return next_token;
+ }
+
+ public string next() throws Error {
+ advance();
+ return peek();
+ }
+
+ public static Mal.Val? read_str(string str) throws Error {
+ var rdr = new Reader(str);
+ if (rdr.peek() == "")
+ return null;
+ var toret = rdr.read_form();
+ if (rdr.peek() != "")
+ throw new Mal.Error.PARSE_ERROR(
+ rdr.poserr("trailing junk after expression"));
+ return toret;
+ }
+
+ public Mal.Val read_form() throws Error {
+ string token = peek();
+ if (token == "(") {
+ next(); // eat (
+ return new Mal.List(read_list(")"));
+ } else {
+ return read_atom();
+ }
+ }
+
+ public GLib.List<Mal.Val> read_list(string endtok) throws Error {
+ var list = new GLib.List<Mal.Val>();
+ string token;
+ while (true) {
+ token = peek();
+ if (token == "")
+ throw new Mal.Error.PARSE_ERROR(poserr("unbalanced parens"));
+ if (token == endtok) {
+ next(); // eat end token
+ return list;
+ }
+
+ list.append(read_form());
+ }
+ }
+
+ public Mal.Hashmap read_hashmap() throws Error {
+ var map = new Mal.Hashmap();
+ string token;
+ while (true) {
+ Mal.Val vals[2];
+ for (int i = 0; i < 2; i++) {
+ token = peek();
+ if (token == "")
+ throw new Mal.Error.PARSE_ERROR(
+ poserr("unbalanced braces"));
+ if (token == "}") {
+ if (i != 0)
+ throw new Mal.Error.PARSE_ERROR(
+ poserr("odd number of elements in hashmap"));
+
+ next(); // eat end token
+ return map;
+ }
+
+ vals[i] = read_form();
+ }
+ map.insert(vals[0], vals[1]);
+ }
+ }
+
+ public Mal.Val read_atom() throws Error {
+ string token = peek();
+ next();
+ if (tok_num.match(token))
+ return new Mal.Num(int64.parse(token));
+ if (token.has_prefix(":"))
+ return new Mal.Keyword(token[1:token.length]);
+ if (token.has_prefix("\"")) {
+ if (!token.has_suffix("\""))
+ throw new Mal.Error.BAD_TOKEN(
+ poserr("end of input in mid-string"));
+
+ token = token[1:token.length-1];
+
+ int end = 0;
+ int pos = 0;
+ string strval = "";
+
+ while ((pos = token.index_of ("\\", end)) != -1) {
+ strval += token[end:pos];
+ switch (token[pos:pos+2]) {
+ case "\\\\":
+ strval += "\\"; break;
+ case "\\\"":
+ strval += "\""; break;
+ case "\\n":
+ strval += "\n"; break;
+ }
+ end = pos+2;
+ }
+ strval += token[end:token.length];
+ return new Mal.String(strval);
+ }
+ switch (token) {
+ case "nil":
+ return new Mal.Nil();
+ case "true":
+ return new Mal.Bool(true);
+ case "false":
+ return new Mal.Bool(false);
+ case "[":
+ return new Mal.Vector.from_list(read_list("]"));
+ case "{":
+ return read_hashmap();
+ case "'":
+ case "`":
+ case "~":
+ case "~@":
+ case "@":
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym(
+ token == "'" ? "quote" :
+ token == "`" ? "quasiquote" :
+ token == "~" ? "unquote" :
+ token == "~@" ? "splice-unquote" : "deref"));
+ list.append(read_form());
+ return new Mal.List(list);
+ case "^":
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("with-meta"));
+ var metadata = read_form();
+ list.append(read_form());
+ list.append(metadata);
+ return new Mal.List(list);
+ default:
+ return new Mal.Sym(token);
+ }
+ }
+}
--- /dev/null
+#!/bin/bash
+exec $(dirname $0)/${STEP:-stepA_mal} "${@}"
--- /dev/null
+class Mal.Main : GLib.Object {
+ public static string? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+ } else {
+ stdout.printf("\n");
+ }
+ return line;
+ }
+
+ public static string EVAL(string expr) {
+ return expr;
+ }
+
+ public static void PRINT(string value) {
+ stdout.printf("%s\n", value);
+ }
+
+ public static bool rep() {
+ string? line = READ();
+ if (line == null)
+ return false;
+ if (line.length > 0) {
+ string value = EVAL(line);
+ PRINT(value);
+ }
+ return true;
+ }
+
+ public static int main(string[] args) {
+ while (rep());
+ return 0;
+ }
+}
--- /dev/null
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val EVAL(Mal.Val expr) {
+ return expr;
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep() {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val);
+ PRINT(val);
+ }
+ }
+
+ public static int main(string[] args) {
+ while (!eof)
+ rep();
+ return 0;
+ }
+}
--- /dev/null
+abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction {
+ public abstract int64 result(int64 a, int64 b);
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ unowned Mal.Num a = args.vs.nth_data(0) as Mal.Num;
+ unowned Mal.Num b = args.vs.nth_data(1) as Mal.Num;
+ if (a == null || b == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ return new Mal.Num(result(a.v, b.v));
+ }
+}
+
+class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionAdd();
+ }
+ public override string name() { return "+"; }
+ public override int64 result(int64 a, int64 b) { return a+b; }
+}
+
+class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSub();
+ }
+ public override string name() { return "-"; }
+ public override int64 result(int64 a, int64 b) { return a-b; }
+}
+
+class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionMul();
+ }
+ public override string name() { return "*"; }
+ public override int64 result(int64 a, int64 b) { return a*b; }
+}
+
+class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionDiv();
+ }
+ public override string name() { return "/"; }
+ public override int64 result(int64 a, int64 b) { return a/b; }
+}
+
+class Mal.Env : GLib.Object {
+ public GLib.HashTable<Mal.Sym, Mal.Val> data;
+ construct {
+ data = new GLib.HashTable<Mal.Sym, Mal.Val>(
+ Mal.Hashable.hash, Mal.Hashable.equal);
+ }
+ // Use the 'new' keyword to silence warnings about 'set' and 'get'
+ // already having meanings that we're overwriting
+ public new void set(Mal.Sym key, Mal.Val f) {
+ data[key] = f;
+ }
+ public new Mal.Val get(Mal.Sym key) throws Mal.Error {
+ var toret = data[key];
+ if (toret == null)
+ throw new Error.ENV_LOOKUP_FAILED("no such variable '%s'", key.v);
+ return toret;
+ }
+}
+
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ var fn = firstlink.data as Mal.BuiltinFunction;
+ newlist.vs.remove_link(firstlink);
+ return fn.call(newlist);
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ env.set(new Mal.Sym("+"), new BuiltinFunctionAdd());
+ env.set(new Mal.Sym("-"), new BuiltinFunctionSub());
+ env.set(new Mal.Sym("*"), new BuiltinFunctionMul());
+ env.set(new Mal.Sym("/"), new BuiltinFunctionDiv());
+
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+abstract class Mal.BuiltinFunctionDyadicArithmetic : Mal.BuiltinFunction {
+ public abstract int64 result(int64 a, int64 b);
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 2)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ unowned Mal.Num a = args.vs.nth_data(0) as Mal.Num;
+ unowned Mal.Num b = args.vs.nth_data(1) as Mal.Num;
+ if (a == null || b == null)
+ throw new Mal.Error.BAD_PARAMS("%s: expected two numbers", name());
+ return new Mal.Num(result(a.v, b.v));
+ }
+}
+
+class Mal.BuiltinFunctionAdd : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionAdd();
+ }
+ public override string name() { return "+"; }
+ public override int64 result(int64 a, int64 b) { return a+b; }
+}
+
+class Mal.BuiltinFunctionSub : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionSub();
+ }
+ public override string name() { return "-"; }
+ public override int64 result(int64 a, int64 b) { return a-b; }
+}
+
+class Mal.BuiltinFunctionMul : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionMul();
+ }
+ public override string name() { return "*"; }
+ public override int64 result(int64 a, int64 b) { return a*b; }
+}
+
+class Mal.BuiltinFunctionDiv : Mal.BuiltinFunctionDyadicArithmetic {
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionDiv();
+ }
+ public override string name() { return "/"; }
+ public override int64 result(int64 a, int64 b) { return a/b; }
+}
+
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env);
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ var newenv = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ newenv, newenv);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], newenv, newenv);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of definitions");
+ }
+ return EVAL(list.nth(2).data, newenv);
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ env.set(new Mal.Sym("+"), new BuiltinFunctionAdd());
+ env.set(new Mal.Sym("-"), new BuiltinFunctionSub());
+ env.set(new Mal.Sym("*"), new BuiltinFunctionMul());
+ env.set(new Mal.Sym("/"), new BuiltinFunctionDiv());
+
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+class Mal.Main: GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env);
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ var newenv = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ newenv, newenv);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], newenv, newenv);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of definitions");
+ }
+ return EVAL(list.nth(2).data, newenv);
+ case "do":
+ Mal.Val result = null;
+ for (list = list.next; list != null; list = list.next)
+ result = EVAL(list.data, env);
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "do: expected at least one argument");
+ return result;
+ case "if":
+ if (list.length() != 3 && list.length() != 4)
+ throw new Mal.Error.BAD_PARAMS(
+ "if: expected two or three arguments");
+ list = list.next;
+ var cond = EVAL(list.data, env);
+ list = list.next;
+ if (!cond.truth_value()) {
+ // Skip to the else clause, which defaults to nil.
+ list = list.next;
+ if (list == null)
+ return new Mal.Nil();
+ }
+ return EVAL(list.data, env);
+ case "fn*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected two arguments");
+ var binds = list.next.data as Mal.Listlike;
+ var body = list.next.next.data;
+ if (binds == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected a list of parameter names");
+ for (var iter = binds.iter(); iter.nonempty(); iter.step())
+ if (!(iter.deref() is Mal.Sym))
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected parameter name to be "+
+ "symbol");
+ return new Mal.Function(binds, body, env);
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else if (firstdata is Mal.Function) {
+ var fn = firstdata as Mal.Function;
+ var newenv = new Mal.Env.funcall(
+ fn.env, fn.parameters, newlist);
+ return EVAL(fn.body, newenv);
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ Mal.Core.make_ns();
+ foreach (var key in Mal.Core.ns.get_keys())
+ env.set(new Mal.Sym(key), Mal.Core.ns[key]);
+
+ try {
+ EVAL(Mal.Reader.read_str("(def! not (fn* (a) (if a false true)))"),
+ env);
+ } catch (Mal.Error err) {
+ assert(false); // shouldn't happen
+ }
+
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_)
+ throws Mal.Error {
+ // Copy the implicitly 'unowned' function arguments into
+ // ordinary owned variables which increment the objects'
+ // reference counts. This is so that when we overwrite these
+ // variables within the loop (for TCO) the objects we assign
+ // into them don't immediately get garbage-collected.
+ Mal.Val ast = ast_;
+ Mal.Env env = env_;
+ while (true) {
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env);
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ env = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ env, env);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], env, env);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of definitions");
+ }
+ ast = list.nth(2).data;
+ continue; // tail-call optimisation
+ case "do":
+ Mal.Val result = null;
+ for (list = list.next; list != null; list = list.next)
+ result = EVAL(list.data, env);
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "do: expected at least one argument");
+ return result;
+ case "if":
+ if (list.length() != 3 && list.length() != 4)
+ throw new Mal.Error.BAD_PARAMS(
+ "if: expected two or three arguments");
+ list = list.next;
+ var cond = EVAL(list.data, env);
+ list = list.next;
+ if (!cond.truth_value()) {
+ // Skip to the else clause, which defaults to nil.
+ list = list.next;
+ if (list == null)
+ return new Mal.Nil();
+ }
+ ast = list.data;
+ continue; // tail-call optimisation
+ case "fn*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected two arguments");
+ var binds = list.next.data as Mal.Listlike;
+ var body = list.next.next.data;
+ if (binds == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected a list of parameter names");
+ for (var iter = binds.iter(); iter.nonempty(); iter.step())
+ if (!(iter.deref() is Mal.Sym))
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected parameter name to be "+
+ "symbol");
+ return new Mal.Function(binds, body, env);
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else if (firstdata is Mal.Function) {
+ var fn = firstdata as Mal.Function;
+ env = new Mal.Env.funcall(fn.env, fn.parameters, newlist);
+ ast = fn.body;
+ continue; // tail-call optimisation
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ Mal.Core.make_ns();
+ foreach (var key in Mal.Core.ns.get_keys())
+ env.set(new Mal.Sym(key), Mal.Core.ns[key]);
+
+ try {
+ EVAL(Mal.Reader.read_str("(def! not (fn* (a) (if a false true)))"),
+ env);
+ } catch (Mal.Error err) {
+ assert(false); // shouldn't happen
+ }
+
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+class Mal.BuiltinFunctionEval : Mal.BuiltinFunction {
+ public Mal.Env env;
+ public BuiltinFunctionEval(Mal.Env env_) { env = env_; }
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionEval(env);
+ }
+ public override string name() { return "eval"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return Mal.Main.EVAL(args.vs.data, env);
+ }
+}
+
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_)
+ throws Mal.Error {
+ // Copy the implicitly 'unowned' function arguments into
+ // ordinary owned variables which increment the objects'
+ // reference counts. This is so that when we overwrite these
+ // variables within the loop (for TCO) the objects we assign
+ // into them don't immediately get garbage-collected.
+ Mal.Val ast = ast_;
+ Mal.Env env = env_;
+ while (true) {
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env);
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ env = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ env, env);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], env, env);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of definitions");
+ }
+ ast = list.nth(2).data;
+ continue; // tail-call optimisation
+ case "do":
+ Mal.Val result = null;
+ for (list = list.next; list != null; list = list.next)
+ result = EVAL(list.data, env);
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "do: expected at least one argument");
+ return result;
+ case "if":
+ if (list.length() != 3 && list.length() != 4)
+ throw new Mal.Error.BAD_PARAMS(
+ "if: expected two or three arguments");
+ list = list.next;
+ var cond = EVAL(list.data, env);
+ list = list.next;
+ if (!cond.truth_value()) {
+ // Skip to the else clause, which defaults to nil.
+ list = list.next;
+ if (list == null)
+ return new Mal.Nil();
+ }
+ ast = list.data;
+ continue; // tail-call optimisation
+ case "fn*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected two arguments");
+ var binds = list.next.data as Mal.Listlike;
+ var body = list.next.next.data;
+ if (binds == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected a list of parameter names");
+ for (var iter = binds.iter(); iter.nonempty(); iter.step())
+ if (!(iter.deref() is Mal.Sym))
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected parameter name to be "+
+ "symbol");
+ return new Mal.Function(binds, body, env);
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else if (firstdata is Mal.Function) {
+ var fn = firstdata as Mal.Function;
+ env = new Mal.Env.funcall(fn.env, fn.parameters, newlist);
+ ast = fn.body;
+ continue; // tail-call optimisation
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static void setup(string line, Mal.Env env) {
+ try {
+ EVAL(Reader.read_str(line), env);
+ } catch (Mal.Error err) {
+ assert(false); // shouldn't happen
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ Mal.Core.make_ns();
+ foreach (var key in Mal.Core.ns.get_keys())
+ env.set(new Mal.Sym(key), Mal.Core.ns[key]);
+ env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env));
+
+ setup("(def! not (fn* (a) (if a false true)))", env);
+ setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env);
+
+ var ARGV = new GLib.List<Mal.Val>();
+ if (args.length > 1) {
+ for (int i = args.length - 1; i >= 2; i--)
+ ARGV.prepend(new Mal.String(args[i]));
+ }
+ env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV));
+
+ if (args.length > 1) {
+ var contents = new GLib.List<Mal.Val>();
+ contents.prepend(new Mal.String(args[1]));
+ contents.prepend(new Mal.Sym("load-file"));
+ try {
+ EVAL(new Mal.List(contents), env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return 1;
+ }
+ } else {
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+class Mal.BuiltinFunctionEval : Mal.BuiltinFunction {
+ public Mal.Env env;
+ public BuiltinFunctionEval(Mal.Env env_) { env = env_; }
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionEval(env);
+ }
+ public override string name() { return "eval"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return Mal.Main.EVAL(args.vs.data, env);
+ }
+}
+
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val quasiquote(Mal.Val ast)
+ throws Mal.Error {
+ if (!is_pair(ast)) {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("quote"));
+ list.append(ast);
+ return new Mal.List(list);
+ }
+
+ var iter = (ast as Mal.Listlike).iter();
+ var first = iter.deref();
+ if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") {
+ if (iter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ return iter.deref();
+ }
+
+ if (is_pair(first)) {
+ var fiter = (first as Mal.Listlike).iter();
+ var ffirst = fiter.deref();
+ if (ffirst is Mal.Sym &&
+ (ffirst as Mal.Sym).v == "splice-unquote") {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("concat"));
+ if (fiter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ list.append(fiter.deref());
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+ }
+
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("cons"));
+ list.append(quasiquote(first));
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_)
+ throws Mal.Error {
+ // Copy the implicitly 'unowned' function arguments into
+ // ordinary owned variables which increment the objects'
+ // reference counts. This is so that when we overwrite these
+ // variables within the loop (for TCO) the objects we assign
+ // into them don't immediately get garbage-collected.
+ Mal.Val ast = ast_;
+ Mal.Env env = env_;
+ while (true) {
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env);
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ env = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ env, env);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], env, env);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of "+
+ "definitions");
+ }
+ ast = list.nth(2).data;
+ continue; // tail-call optimisation
+ case "do":
+ Mal.Val result = null;
+ for (list = list.next; list != null; list = list.next)
+ result = EVAL(list.data, env);
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "do: expected at least one argument");
+ return result;
+ case "if":
+ if (list.length() != 3 && list.length() != 4)
+ throw new Mal.Error.BAD_PARAMS(
+ "if: expected two or three arguments");
+ list = list.next;
+ var cond = EVAL(list.data, env);
+ list = list.next;
+ if (!cond.truth_value()) {
+ // Skip to the else clause, which defaults to nil.
+ list = list.next;
+ if (list == null)
+ return new Mal.Nil();
+ }
+ ast = list.data;
+ continue; // tail-call optimisation
+ case "fn*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected two arguments");
+ var binds = list.next.data as Mal.Listlike;
+ var body = list.next.next.data;
+ if (binds == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected a list of parameter names");
+ for (var iter = binds.iter(); iter.nonempty();
+ iter.step())
+ if (!(iter.deref() is Mal.Sym))
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected parameter name to be "+
+ "symbol");
+ return new Mal.Function(binds, body, env);
+ case "quote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quote: expected one argument");
+ return list.next.data;
+ case "quasiquote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quasiquote: expected one argument");
+ ast = quasiquote(list.next.data);
+ continue; // tail-call optimisation
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else if (firstdata is Mal.Function) {
+ var fn = firstdata as Mal.Function;
+ env = new Mal.Env.funcall(fn.env, fn.parameters, newlist);
+ ast = fn.body;
+ continue; // tail-call optimisation
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static void setup(string line, Mal.Env env) {
+ try {
+ EVAL(Reader.read_str(line), env);
+ } catch (Mal.Error err) {
+ assert(false); // shouldn't happen
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ Mal.Core.make_ns();
+ foreach (var key in Mal.Core.ns.get_keys())
+ env.set(new Mal.Sym(key), Mal.Core.ns[key]);
+ env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env));
+
+ setup("(def! not (fn* (a) (if a false true)))", env);
+ setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env);
+
+ var ARGV = new GLib.List<Mal.Val>();
+ if (args.length > 1) {
+ for (int i = args.length - 1; i >= 2; i--)
+ ARGV.prepend(new Mal.String(args[i]));
+ }
+ env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV));
+
+ if (args.length > 1) {
+ var contents = new GLib.List<Mal.Val>();
+ contents.prepend(new Mal.String(args[1]));
+ contents.prepend(new Mal.Sym("load-file"));
+ try {
+ EVAL(new Mal.List(contents), env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return 1;
+ }
+ } else {
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+class Mal.BuiltinFunctionEval : Mal.BuiltinFunction {
+ public Mal.Env env;
+ public BuiltinFunctionEval(Mal.Env env_) { env = env_; }
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionEval(env);
+ }
+ public override string name() { return "eval"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return Mal.Main.EVAL(args.vs.data, env);
+ }
+}
+
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env,
+ bool is_macro = false)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ if (val is Mal.Function)
+ (val as Mal.Function).is_macro = is_macro;
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val quasiquote(Mal.Val ast)
+ throws Mal.Error {
+ if (!is_pair(ast)) {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("quote"));
+ list.append(ast);
+ return new Mal.List(list);
+ }
+
+ var iter = (ast as Mal.Listlike).iter();
+ var first = iter.deref();
+ if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") {
+ if (iter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ return iter.deref();
+ }
+
+ if (is_pair(first)) {
+ var fiter = (first as Mal.Listlike).iter();
+ var ffirst = fiter.deref();
+ if (ffirst is Mal.Sym &&
+ (ffirst as Mal.Sym).v == "splice-unquote") {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("concat"));
+ if (fiter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ list.append(fiter.deref());
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+ }
+
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("cons"));
+ list.append(quasiquote(first));
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+
+ public static bool is_macro_call(Mal.Val v, Mal.Env env) {
+ var list = v as Mal.List;
+ if (list == null || list.vs == null || !(list.vs.data is Mal.Sym))
+ return false;
+ try {
+ var fn = env.get(list.vs.data as Mal.Sym) as Mal.Function;
+ return (fn != null && fn.is_macro);
+ } catch (Mal.Error err) {
+ return false;
+ }
+ }
+
+ public static Mal.Val macroexpand(Mal.Val ast_, Mal.Env env)
+ throws Mal.Error {
+ Mal.Val ast = ast_;
+ while (is_macro_call(ast, env)) {
+ var call = ast as Mal.List;
+ var macro = (env.get(call.vs.data as Mal.Sym) as Mal.Function);
+ var macroargs = new Mal.List(call.vs.copy());
+ macroargs.vs.remove_link(macroargs.vs.first());
+ var fnenv = new Mal.Env.funcall(
+ macro.env, macro.parameters, macroargs);
+ ast = Mal.Main.EVAL(macro.body, fnenv);
+ }
+ return ast;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_)
+ throws Mal.Error {
+ // Copy the implicitly 'unowned' function arguments into
+ // ordinary owned variables which increment the objects'
+ // reference counts. This is so that when we overwrite these
+ // variables within the loop (for TCO) the objects we assign
+ // into them don't immediately get garbage-collected.
+ Mal.Val ast = ast_;
+ Mal.Env env = env_;
+ while (true) {
+ ast = macroexpand(ast, env);
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ case "defmacro!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env, sym.v == "defmacro!");
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ env = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ env, env);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], env, env);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of definitions");
+ }
+ ast = list.nth(2).data;
+ continue; // tail-call optimisation
+ case "do":
+ Mal.Val result = null;
+ for (list = list.next; list != null; list = list.next)
+ result = EVAL(list.data, env);
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "do: expected at least one argument");
+ return result;
+ case "if":
+ if (list.length() != 3 && list.length() != 4)
+ throw new Mal.Error.BAD_PARAMS(
+ "if: expected two or three arguments");
+ list = list.next;
+ var cond = EVAL(list.data, env);
+ list = list.next;
+ if (!cond.truth_value()) {
+ // Skip to the else clause, which defaults to nil.
+ list = list.next;
+ if (list == null)
+ return new Mal.Nil();
+ }
+ ast = list.data;
+ continue; // tail-call optimisation
+ case "fn*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected two arguments");
+ var binds = list.next.data as Mal.Listlike;
+ var body = list.next.next.data;
+ if (binds == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected a list of parameter names");
+ for (var iter = binds.iter(); iter.nonempty();
+ iter.step())
+ if (!(iter.deref() is Mal.Sym))
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected parameter name to be "+
+ "symbol");
+ return new Mal.Function(binds, body, env);
+ case "quote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quote: expected one argument");
+ return list.next.data;
+ case "quasiquote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quasiquote: expected one argument");
+ ast = quasiquote(list.next.data);
+ continue; // tail-call optimisation
+ case "macroexpand":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "macroexpand: expected one argument");
+ return macroexpand(list.next.data, env);
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else if (firstdata is Mal.Function) {
+ var fn = firstdata as Mal.Function;
+ env = new Mal.Env.funcall(fn.env, fn.parameters, newlist);
+ ast = fn.body;
+ continue; // tail-call optimisation
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static void setup(string line, Mal.Env env) {
+ try {
+ EVAL(Reader.read_str(line), env);
+ } catch (Mal.Error err) {
+ assert(false); // shouldn't happen
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ Mal.Core.make_ns();
+ foreach (var key in Mal.Core.ns.get_keys())
+ env.set(new Mal.Sym(key), Mal.Core.ns[key]);
+ env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env));
+
+ setup("(def! not (fn* (a) (if a false true)))", env);
+ setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env);
+ setup("(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)))))))", env);
+ setup("(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))))))))", env);
+
+ var ARGV = new GLib.List<Mal.Val>();
+ if (args.length > 1) {
+ for (int i = args.length - 1; i >= 2; i--)
+ ARGV.prepend(new Mal.String(args[i]));
+ }
+ env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV));
+
+ if (args.length > 1) {
+ var contents = new GLib.List<Mal.Val>();
+ contents.prepend(new Mal.String(args[1]));
+ contents.prepend(new Mal.Sym("load-file"));
+ try {
+ EVAL(new Mal.List(contents), env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return 1;
+ }
+ } else {
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+class Mal.BuiltinFunctionEval : Mal.BuiltinFunction {
+ public Mal.Env env;
+ public BuiltinFunctionEval(Mal.Env env_) { env = env_; }
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionEval(env);
+ }
+ public override string name() { return "eval"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return Mal.Main.EVAL(args.vs.data, env);
+ }
+}
+
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ Mal.BuiltinFunctionThrow.clear();
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env,
+ bool is_macro = false)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ if (val is Mal.Function)
+ (val as Mal.Function).is_macro = is_macro;
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val quasiquote(Mal.Val ast)
+ throws Mal.Error {
+ if (!is_pair(ast)) {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("quote"));
+ list.append(ast);
+ return new Mal.List(list);
+ }
+
+ var iter = (ast as Mal.Listlike).iter();
+ var first = iter.deref();
+ if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") {
+ if (iter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ return iter.deref();
+ }
+
+ if (is_pair(first)) {
+ var fiter = (first as Mal.Listlike).iter();
+ var ffirst = fiter.deref();
+ if (ffirst is Mal.Sym &&
+ (ffirst as Mal.Sym).v == "splice-unquote") {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("concat"));
+ if (fiter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ list.append(fiter.deref());
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+ }
+
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("cons"));
+ list.append(quasiquote(first));
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+
+ public static bool is_macro_call(Mal.Val v, Mal.Env env)
+ throws Mal.Error {
+ var list = v as Mal.List;
+ if (list == null || list.vs == null || !(list.vs.data is Mal.Sym))
+ return false;
+ try {
+ var fn = env.get(list.vs.data as Mal.Sym) as Mal.Function;
+ return (fn != null && fn.is_macro);
+ } catch (Mal.Error.ENV_LOOKUP_FAILED err) {
+ return false;
+ }
+ }
+
+ public static Mal.Val macroexpand(Mal.Val ast_, Mal.Env env)
+ throws Mal.Error {
+ // Copy the parameter into an owned variable (see comment in EVAL).
+ Mal.Val ast = ast_;
+ while (is_macro_call(ast, env)) {
+ var call = ast as Mal.List;
+ var macro = (env.get(call.vs.data as Mal.Sym) as Mal.Function);
+ var macroargs = new Mal.List(call.vs.copy());
+ macroargs.vs.remove_link(macroargs.vs.first());
+ var fnenv = new Mal.Env.funcall(
+ macro.env, macro.parameters, macroargs);
+ ast = Mal.Main.EVAL(macro.body, fnenv);
+ }
+ return ast;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_)
+ throws Mal.Error {
+ // Copy the implicitly 'unowned' function arguments into
+ // ordinary owned variables which increment the objects'
+ // reference counts. This is so that when we overwrite these
+ // variables within the loop (for TCO) the objects we assign
+ // into them don't immediately get garbage-collected.
+ Mal.Val ast = ast_;
+ Mal.Env env = env_;
+ while (true) {
+ ast = macroexpand(ast, env);
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ case "defmacro!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env, sym.v == "defmacro!");
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ env = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ env, env);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], env, env);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of definitions");
+ }
+ ast = list.nth(2).data;
+ continue; // tail-call optimisation
+ case "do":
+ Mal.Val result = null;
+ for (list = list.next; list != null; list = list.next)
+ result = EVAL(list.data, env);
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "do: expected at least one argument");
+ return result;
+ case "if":
+ if (list.length() != 3 && list.length() != 4)
+ throw new Mal.Error.BAD_PARAMS(
+ "if: expected two or three arguments");
+ list = list.next;
+ var cond = EVAL(list.data, env);
+ list = list.next;
+ if (!cond.truth_value()) {
+ // Skip to the else clause, which defaults to nil.
+ list = list.next;
+ if (list == null)
+ return new Mal.Nil();
+ }
+ ast = list.data;
+ continue; // tail-call optimisation
+ case "fn*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected two arguments");
+ var binds = list.next.data as Mal.Listlike;
+ var body = list.next.next.data;
+ if (binds == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected a list of parameter names");
+ for (var iter = binds.iter(); iter.nonempty();
+ iter.step())
+ if (!(iter.deref() is Mal.Sym))
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected parameter name to be "+
+ "symbol");
+ return new Mal.Function(binds, body, env);
+ case "quote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quote: expected one argument");
+ return list.next.data;
+ case "quasiquote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quasiquote: expected one argument");
+ ast = quasiquote(list.next.data);
+ continue; // tail-call optimisation
+ case "macroexpand":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "macroexpand: expected one argument");
+ return macroexpand(list.next.data, env);
+ case "try*":
+ if (list.length() != 2 && list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "try*: expected one or two arguments");
+ var trybody = list.next.data;
+ if (list.length() == 2) {
+ // Trivial catchless form of try
+ ast = trybody;
+ continue; // tail-call optimisation
+ }
+ var catchclause = list.next.next.data as Mal.List;
+ if (!(catchclause.vs.data is Mal.Sym) ||
+ (catchclause.vs.data as Mal.Sym).v != "catch*")
+ throw new Mal.Error.BAD_PARAMS(
+ "try*: expected catch*");
+ if (catchclause.vs.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "catch*: expected two arguments");
+ var catchparam = catchclause.vs.next.data as Mal.Sym;
+ if (catchparam == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "catch*: expected a parameter name");
+ var catchbody = catchclause.vs.next.next.data;
+ try {
+ return EVAL(trybody, env);
+ } catch (Mal.Error exc) {
+ var catchenv = new Mal.Env.within(env);
+ catchenv.set(catchparam, Mal.BuiltinFunctionThrow.
+ thrown_value(exc));
+ ast = catchbody;
+ env = catchenv;
+ continue; // tail-call optimisation
+ }
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else if (firstdata is Mal.Function) {
+ var fn = firstdata as Mal.Function;
+ env = new Mal.Env.funcall(fn.env, fn.parameters, newlist);
+ ast = fn.body;
+ continue; // tail-call optimisation
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static void setup(string line, Mal.Env env) {
+ try {
+ EVAL(Reader.read_str(line), env);
+ } catch (Mal.Error err) {
+ stderr.printf("Error during setup:\n%s\n-> %s\n",
+ line, err.message);
+ GLib.Process.exit(1);
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ Mal.Core.make_ns();
+ foreach (var key in Mal.Core.ns.get_keys())
+ env.set(new Mal.Sym(key), Mal.Core.ns[key]);
+ env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env));
+
+ setup("(def! not (fn* (a) (if a false true)))", env);
+ setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env);
+ setup("(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)))))))", env);
+ setup("(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))))))))", env);
+
+ var ARGV = new GLib.List<Mal.Val>();
+ if (args.length > 1) {
+ for (int i = args.length - 1; i >= 2; i--)
+ ARGV.prepend(new Mal.String(args[i]));
+ }
+ env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV));
+
+ if (args.length > 1) {
+ var contents = new GLib.List<Mal.Val>();
+ contents.prepend(new Mal.String(args[1]));
+ contents.prepend(new Mal.Sym("load-file"));
+ try {
+ EVAL(new Mal.List(contents), env);
+ } catch (Mal.Error.EXCEPTION_THROWN exc) {
+ GLib.stderr.printf(
+ "uncaught exception: %s\n",
+ pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc)));
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return 1;
+ }
+ } else {
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error.EXCEPTION_THROWN exc) {
+ GLib.stderr.printf(
+ "uncaught exception: %s\n",
+ pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc)));
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+class Mal.BuiltinFunctionEval : Mal.BuiltinFunction {
+ public Mal.Env env;
+ public BuiltinFunctionEval(Mal.Env env_) { env = env_; }
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.BuiltinFunctionEval(env);
+ }
+ public override string name() { return "eval"; }
+ public override Mal.Val call(Mal.List args) throws Mal.Error {
+ if (args.vs.length() != 1)
+ throw new Mal.Error.BAD_PARAMS("%s: expected one argument", name());
+ return Mal.Main.EVAL(args.vs.data, env);
+ }
+}
+
+class Mal.Main : GLib.Object {
+ static bool eof;
+
+ static construct {
+ eof = false;
+ }
+
+ public static Mal.Val? READ() {
+ string? line = Readline.readline("user> ");
+ if (line != null) {
+ if (line.length > 0)
+ Readline.History.add(line);
+
+ try {
+ return Reader.read_str(line);
+ } catch (Mal.Error err) {
+ Mal.BuiltinFunctionThrow.clear();
+ GLib.stderr.printf("%s\n", err.message);
+ return null;
+ }
+ } else {
+ stdout.printf("\n");
+ eof = true;
+ return null;
+ }
+ }
+
+ public static Mal.Val eval_ast(Mal.Val ast, Mal.Env env)
+ throws Mal.Error {
+ if (ast is Mal.Sym)
+ return env.get(ast as Mal.Sym);
+ if (ast is Mal.List) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.List).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.List(results);
+ }
+ if (ast is Mal.Vector) {
+ var results = new GLib.List<Mal.Val>();
+ foreach (var elt in (ast as Mal.Vector).vs)
+ results.append(EVAL(elt, env));
+ return new Mal.Vector.from_list(results);
+ }
+ if (ast is Mal.Hashmap) {
+ var result = new Mal.Hashmap();
+ var map = (ast as Mal.Hashmap).vs;
+ foreach (var key in map.get_keys())
+ result.insert(key, EVAL(map[key], env));
+ return result;
+ }
+ return ast;
+ }
+
+ private static Mal.Val define_eval(Mal.Val key, Mal.Val value,
+ Mal.Env eval_env, Mal.Env def_env,
+ bool is_macro = false)
+ throws Mal.Error {
+ var symkey = key as Mal.Sym;
+ if (symkey == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a symbol to define");
+ var val = EVAL(value, eval_env);
+ if (val is Mal.Function)
+ (val as Mal.Function).is_macro = is_macro;
+ def_env.set(symkey, val);
+ return val;
+ }
+
+ public static Mal.Val quasiquote(Mal.Val ast)
+ throws Mal.Error {
+ if (!is_pair(ast)) {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("quote"));
+ list.append(ast);
+ return new Mal.List(list);
+ }
+
+ var iter = (ast as Mal.Listlike).iter();
+ var first = iter.deref();
+ if (first is Mal.Sym && (first as Mal.Sym).v == "unquote") {
+ if (iter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ return iter.deref();
+ }
+
+ if (is_pair(first)) {
+ var fiter = (first as Mal.Listlike).iter();
+ var ffirst = fiter.deref();
+ if (ffirst is Mal.Sym &&
+ (ffirst as Mal.Sym).v == "splice-unquote") {
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("concat"));
+ if (fiter.step().empty())
+ throw new Mal.Error.BAD_PARAMS(
+ "unquote: expected two values");
+ list.append(fiter.deref());
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+ }
+
+ var list = new GLib.List<Mal.Val>();
+ list.append(new Mal.Sym("cons"));
+ list.append(quasiquote(first));
+ var sublist = new GLib.List<Mal.Val>();
+ while (!iter.step().empty())
+ sublist.append(iter.deref());
+ list.append(quasiquote(new Mal.List(sublist)));
+ return new Mal.List(list);
+ }
+
+ public static bool is_macro_call(Mal.Val v, Mal.Env env)
+ throws Mal.Error {
+ var list = v as Mal.List;
+ if (list == null || list.vs == null || !(list.vs.data is Mal.Sym))
+ return false;
+ try {
+ var fn = env.get(list.vs.data as Mal.Sym) as Mal.Function;
+ return (fn != null && fn.is_macro);
+ } catch (Mal.Error.ENV_LOOKUP_FAILED err) {
+ return false;
+ }
+ }
+
+ public static Mal.Val macroexpand(Mal.Val ast_, Mal.Env env)
+ throws Mal.Error {
+ // Copy the parameter into an owned variable (see comment in EVAL).
+ Mal.Val ast = ast_;
+ while (is_macro_call(ast, env)) {
+ var call = ast as Mal.List;
+ var macro = (env.get(call.vs.data as Mal.Sym) as Mal.Function);
+ var macroargs = new Mal.List(call.vs.copy());
+ macroargs.vs.remove_link(macroargs.vs.first());
+ var fnenv = new Mal.Env.funcall(
+ macro.env, macro.parameters, macroargs);
+ ast = Mal.Main.EVAL(macro.body, fnenv);
+ }
+ return ast;
+ }
+
+ public static Mal.Val EVAL(Mal.Val ast_, Mal.Env env_)
+ throws Mal.Error {
+ // Copy the implicitly 'unowned' function arguments into
+ // ordinary owned variables which increment the objects'
+ // reference counts. This is so that when we overwrite these
+ // variables within the loop (for TCO) the objects we assign
+ // into them don't immediately get garbage-collected.
+ Mal.Val ast = ast_;
+ Mal.Env env = env_;
+ while (true) {
+ ast = macroexpand(ast, env);
+ if (ast is Mal.List) {
+ unowned GLib.List<Mal.Val> list = (ast as Mal.List).vs;
+ if (list.first() == null)
+ return ast;
+
+ var first = list.first().data;
+ if (first is Mal.Sym) {
+ var sym = first as Mal.Sym;
+ switch (sym.v) {
+ case "def!":
+ case "defmacro!":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "def!: expected two values");
+ return define_eval(list.next.data, list.next.next.data,
+ env, env, sym.v == "defmacro!");
+ case "let*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected two values");
+ var defns = list.nth(1).data;
+ env = new Mal.Env.within(env);
+
+ if (defns is Mal.List) {
+ for (unowned GLib.List<Mal.Val> iter =
+ (defns as Mal.List).vs;
+ iter != null; iter = iter.next.next) {
+ if (iter.next == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length list" +
+ " of definitions");
+ define_eval(iter.data, iter.next.data,
+ env, env);
+ }
+ } else if (defns is Mal.Vector) {
+ var vec = (defns as Mal.Vector).vs;
+ if (vec.length % 2 != 0)
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected an even-length vector" +
+ " of definitions");
+ for (var i = 0; i < vec.length; i += 2)
+ define_eval(vec[i], vec[i+1], env, env);
+ } else {
+ throw new Mal.Error.BAD_PARAMS(
+ "let*: expected a list or vector of definitions");
+ }
+ ast = list.nth(2).data;
+ continue; // tail-call optimisation
+ case "do":
+ Mal.Val result = null;
+ for (list = list.next; list != null; list = list.next)
+ result = EVAL(list.data, env);
+ if (result == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "do: expected at least one argument");
+ return result;
+ case "if":
+ if (list.length() != 3 && list.length() != 4)
+ throw new Mal.Error.BAD_PARAMS(
+ "if: expected two or three arguments");
+ list = list.next;
+ var cond = EVAL(list.data, env);
+ list = list.next;
+ if (!cond.truth_value()) {
+ // Skip to the else clause, which defaults to nil.
+ list = list.next;
+ if (list == null)
+ return new Mal.Nil();
+ }
+ ast = list.data;
+ continue; // tail-call optimisation
+ case "fn*":
+ if (list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected two arguments");
+ var binds = list.next.data as Mal.Listlike;
+ var body = list.next.next.data;
+ if (binds == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected a list of parameter names");
+ for (var iter = binds.iter(); iter.nonempty();
+ iter.step())
+ if (!(iter.deref() is Mal.Sym))
+ throw new Mal.Error.BAD_PARAMS(
+ "fn*: expected parameter name to be "+
+ "symbol");
+ return new Mal.Function(binds, body, env);
+ case "quote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quote: expected one argument");
+ return list.next.data;
+ case "quasiquote":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "quasiquote: expected one argument");
+ ast = quasiquote(list.next.data);
+ continue; // tail-call optimisation
+ case "macroexpand":
+ if (list.length() != 2)
+ throw new Mal.Error.BAD_PARAMS(
+ "macroexpand: expected one argument");
+ return macroexpand(list.next.data, env);
+ case "try*":
+ if (list.length() != 2 && list.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "try*: expected one or two arguments");
+ var trybody = list.next.data;
+ if (list.length() == 2) {
+ // Trivial catchless form of try
+ ast = trybody;
+ continue; // tail-call optimisation
+ }
+ var catchclause = list.next.next.data as Mal.List;
+ if (!(catchclause.vs.data is Mal.Sym) ||
+ (catchclause.vs.data as Mal.Sym).v != "catch*")
+ throw new Mal.Error.BAD_PARAMS(
+ "try*: expected catch*");
+ if (catchclause.vs.length() != 3)
+ throw new Mal.Error.BAD_PARAMS(
+ "catch*: expected two arguments");
+ var catchparam = catchclause.vs.next.data as Mal.Sym;
+ if (catchparam == null)
+ throw new Mal.Error.BAD_PARAMS(
+ "catch*: expected a parameter name");
+ var catchbody = catchclause.vs.next.next.data;
+ try {
+ return EVAL(trybody, env);
+ } catch (Mal.Error exc) {
+ var catchenv = new Mal.Env.within(env);
+ catchenv.set(catchparam, Mal.BuiltinFunctionThrow.
+ thrown_value(exc));
+ ast = catchbody;
+ env = catchenv;
+ continue; // tail-call optimisation
+ }
+ }
+ }
+
+ var newlist = eval_ast(ast, env) as Mal.List;
+ unowned GLib.List<Mal.Val> firstlink = newlist.vs.first();
+ Mal.Val firstdata = firstlink.data;
+ newlist.vs.remove_link(firstlink);
+
+ if (firstdata is Mal.BuiltinFunction) {
+ return (firstdata as Mal.BuiltinFunction).call(newlist);
+ } else if (firstdata is Mal.Function) {
+ var fn = firstdata as Mal.Function;
+ env = new Mal.Env.funcall(fn.env, fn.parameters, newlist);
+ ast = fn.body;
+ continue; // tail-call optimisation
+ } else {
+ throw new Mal.Error.CANNOT_APPLY(
+ "bad value at start of list");
+ }
+ } else {
+ return eval_ast(ast, env);
+ }
+ }
+ }
+
+ public static void PRINT(Mal.Val value) {
+ stdout.printf("%s\n", pr_str(value));
+ }
+
+ public static void rep(Mal.Env env) throws Mal.Error {
+ Mal.Val? val = READ();
+ if (val != null) {
+ val = EVAL(val, env);
+ PRINT(val);
+ }
+ }
+
+ public static void setup(string line, Mal.Env env) {
+ try {
+ EVAL(Reader.read_str(line), env);
+ } catch (Mal.Error err) {
+ stderr.printf("Error during setup:\n%s\n-> %s\n",
+ line, err.message);
+ GLib.Process.exit(1);
+ }
+ }
+
+ public static int main(string[] args) {
+ var env = new Mal.Env();
+
+ Mal.Core.make_ns();
+ foreach (var key in Mal.Core.ns.get_keys())
+ env.set(new Mal.Sym(key), Mal.Core.ns[key]);
+ env.set(new Mal.Sym("eval"), new Mal.BuiltinFunctionEval(env));
+ env.set(new Mal.Sym("*host-language*"), new Mal.String("vala"));
+
+ setup("(def! not (fn* (a) (if a false true)))", env);
+ setup("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", env);
+ setup("(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)))))))", env);
+ setup("(def! *gensym-counter* (atom 0))", env);
+ setup("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", env);
+ setup("(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)))))))))", env);
+
+ var ARGV = new GLib.List<Mal.Val>();
+ if (args.length > 1) {
+ for (int i = args.length - 1; i >= 2; i--)
+ ARGV.prepend(new Mal.String(args[i]));
+ }
+ env.set(new Mal.Sym("*ARGV*"), new Mal.List(ARGV));
+
+ if (args.length > 1) {
+ var contents = new GLib.List<Mal.Val>();
+ contents.prepend(new Mal.String(args[1]));
+ contents.prepend(new Mal.Sym("load-file"));
+ try {
+ EVAL(new Mal.List(contents), env);
+ } catch (Mal.Error.EXCEPTION_THROWN exc) {
+ GLib.stderr.printf(
+ "uncaught exception: %s\n",
+ pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc)));
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ return 1;
+ }
+ } else {
+ setup("(println (str \"Mal [\" *host-language* \"]\"))", env);
+ while (!eof) {
+ try {
+ rep(env);
+ } catch (Mal.Error.EXCEPTION_THROWN exc) {
+ GLib.stderr.printf(
+ "uncaught exception: %s\n",
+ pr_str(Mal.BuiltinFunctionThrow.thrown_value(exc)));
+ } catch (Mal.Error err) {
+ GLib.stderr.printf("%s\n", err.message);
+ }
+ }
+ }
+ return 0;
+ }
+}
--- /dev/null
+public errordomain Mal.Error {
+ BAD_TOKEN,
+ PARSE_ERROR,
+ HASH_KEY_TYPE_ERROR,
+ ENV_LOOKUP_FAILED,
+ BAD_PARAMS,
+ CANNOT_APPLY,
+ EXCEPTION_THROWN,
+ NOT_IMPLEMENTED_IN_THIS_STEP,
+}
+
+abstract class Mal.Val : GLib.Object {
+ public abstract bool truth_value();
+}
+
+abstract class Mal.Hashable : Mal.Val {
+ public string hashkey;
+ public static uint hash(Hashable h) { return str_hash(h.hashkey); }
+ public static bool equal(Hashable hl, Hashable hr) {
+ return hl.hashkey == hr.hashkey;
+ }
+}
+
+class Mal.Bool : Mal.Hashable {
+ public bool v;
+ public Bool(bool value) {
+ v = value;
+ hashkey = value ? "bt" : "bf";
+ }
+ public override bool truth_value() { return v; }
+}
+
+// Mal.Listlike is a subclass of Mal.Val which includes both lists and
+// vectors, and provides a common iterator API so that core functions
+// and special forms can treat them the same.
+//
+// Most core functions that take a list argument also accept nil. To
+// make that easy, Mal.Nil also derives from Mal.Listlike.
+abstract class Mal.Listlike : Mal.ValWithMetadata {
+ public abstract Mal.Iterator iter();
+ public GLib.List<Mal.Val> as_glib_list() {
+ var newlist = new GLib.List<Mal.Val>();
+ for (var it = iter(); it.nonempty(); it.step())
+ newlist.append(it.deref());
+ return newlist;
+ }
+}
+
+abstract class Mal.Iterator : GLib.Object {
+ public abstract Mal.Val? deref();
+ public abstract Mal.Iterator step();
+ public bool empty() { return deref() == null; }
+ public bool nonempty() { return deref() != null; }
+}
+
+// ValWithMetadata is a subclass of Mal.Val which includes every value
+// type you can put metadata on. Value types implementing this class
+// must provide a copy() method, because with-meta has to make a copy
+// of the value with new metadata.
+//
+// The subclass Mal.Listlike (including lists, vectors and nil)
+// descends from ValWithMetadata. This means there's a tricky moment
+// during construction where we initialise the metadata to nil by
+// default, which involves constructing a Mal.Nil, which is also a
+// ValWithMetadata! To avoid an infinite recursion, Mal.Nil has to
+// point to _itself_ as its default metadata, instead of a separately
+// constructed Mal.Nil.
+abstract class Mal.ValWithMetadata : Mal.Val {
+ public Mal.Val metadata;
+ construct {
+ if (this is Mal.Nil)
+ metadata = this;
+ else
+ metadata = new Mal.Nil();
+ }
+ public abstract Mal.ValWithMetadata copy();
+}
+
+class Mal.Nil : Mal.Listlike {
+ public override bool truth_value() { return false; }
+ public override Mal.Iterator iter() { return new Mal.NilIterator(); }
+ public override Mal.ValWithMetadata copy() { return new Mal.Nil(); }
+}
+
+class Mal.NilIterator : Mal.Iterator {
+ public override Mal.Val? deref() { return null; }
+ public override Mal.Iterator step() { return this; }
+}
+
+class Mal.List : Mal.Listlike {
+ public GLib.List<Val> vs;
+ public List(GLib.List<Val> values) {
+ foreach (var value in values) {
+ vs.append(value);
+ }
+ }
+ public List.empty() {
+ }
+ public override bool truth_value() { return true; }
+ public override Mal.Iterator iter() {
+ var toret = new Mal.ListIterator();
+ toret.node = vs;
+ return toret;
+ }
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.List(vs);
+ }
+}
+
+class Mal.ListIterator : Mal.Iterator {
+ public unowned GLib.List<Mal.Val>? node;
+ public override Mal.Val? deref() {
+ return node == null ? null : node.data;
+ }
+ public override Mal.Iterator step() {
+ if (node != null)
+ node = node.next;
+ return this;
+ }
+}
+
+class Mal.Vector : Mal.Listlike {
+ public Val[] vs;
+ public Vector.from_list(GLib.List<Val> values) {
+ vs = new Val[values.length()];
+ int i = 0;
+ foreach (var value in values) {
+ vs[i++] = value;
+ }
+ }
+ public Vector.with_size(uint size) {
+ vs = new Val[size];
+ }
+ private Vector.copy_of(Vector v) {
+ vs = v.vs;
+ }
+ public override bool truth_value() { return true; }
+ public override Mal.Iterator iter() {
+ var toret = new Mal.VectorIterator();
+ toret.vec = this;
+ toret.pos = 0;
+ return toret;
+ }
+ public override Mal.ValWithMetadata copy() {
+ return new Mal.Vector.copy_of(this);
+ }
+}
+
+class Mal.VectorIterator : Mal.Iterator {
+ public Mal.Vector vec;
+ public int pos;
+ public override Mal.Val? deref() {
+ return pos >= vec.vs.length ? null : vec.vs[pos];
+ }
+ public override Mal.Iterator step() {
+ if (pos < vec.vs.length) pos++;
+ return this;
+ }
+}
+
+class Mal.Num : Mal.Hashable {
+ public int64 v;
+ public Num(int64 value) {
+ v = value;
+ hashkey = "N" + v.to_string();
+ }
+ public override bool truth_value() { return true; }
+}
+
+abstract class Mal.SymBase : Mal.Hashable {
+ public string v;
+ public override bool truth_value() { return true; }
+}
+
+class Mal.Sym : Mal.SymBase {
+ public Sym(string value) {
+ v = value;
+ hashkey = "'" + v;
+ }
+}
+
+class Mal.Keyword : Mal.SymBase {
+ public Keyword(string value) {
+ v = value;
+ hashkey = ":" + v;
+ }
+}
+
+class Mal.String : Mal.Hashable {
+ public string v;
+ public String(string value) {
+ v = value;
+ hashkey = "\"" + v;
+ }
+ public override bool truth_value() { return true; }
+}
+
+class Mal.Hashmap : Mal.ValWithMetadata {
+ public GLib.HashTable<Mal.Hashable, Mal.Val> vs;
+ construct {
+ vs = new GLib.HashTable<Mal.Hashable, Mal.Val>(
+ Mal.Hashable.hash, Mal.Hashable.equal);
+ }
+ public void insert(Mal.Val key, Mal.Val value) throws Mal.Error {
+ var hkey = key as Mal.Hashable;
+ if (hkey == null)
+ throw new Error.HASH_KEY_TYPE_ERROR("bad type as hash key");
+ vs[hkey] = value;
+ }
+ public void remove(Mal.Val key) throws Mal.Error {
+ var hkey = key as Mal.Hashable;
+ if (hkey == null)
+ throw new Error.HASH_KEY_TYPE_ERROR("bad type as hash key");
+ vs.remove(hkey);
+ }
+ public override bool truth_value() { return true; }
+ public override Mal.ValWithMetadata copy() {
+ var toret = new Mal.Hashmap();
+ toret.vs = vs;
+ return toret;
+ }
+}
+
+abstract class Mal.BuiltinFunction : Mal.ValWithMetadata {
+ public abstract string name();
+ public abstract Mal.Val call(Mal.List args) throws Mal.Error;
+ public override bool truth_value() { return true; }
+}
+
+class Mal.Function : Mal.ValWithMetadata {
+ public bool is_macro;
+#if !NO_ENV
+ public Mal.Listlike parameters;
+ public Mal.Val body;
+ public Mal.Env env;
+ public Function(Mal.Listlike parameters_, Mal.Val body_, Mal.Env env_) {
+ parameters = parameters_;
+ body = body_;
+ env = env_;
+ is_macro = false;
+ }
+#endif
+ public override Mal.ValWithMetadata copy() {
+#if !NO_ENV
+ var copied = new Mal.Function(parameters, body, env);
+ copied.is_macro = is_macro;
+ return copied;
+#else
+ throw new Mal.Error.NOT_IMPLEMENTED_IN_THIS_STEP(
+ "can't copy a Mal.Function without Mal.Env existing");
+#endif
+ }
+ public override bool truth_value() { return true; }
+}
+
+class Mal.Atom : Mal.Val {
+ public Mal.Val v;
+ public Atom(Mal.Val v_) { v = v_; }
+ public override bool truth_value() { return true; }
+}
+
+bool is_pair(Mal.Val v) {
+ var listlike = v as Mal.Listlike;
+ return listlike != null && listlike.iter().nonempty();
+}
HCoop / jackhill / mal.git / commitdiff