/// credits

// Abstract machine is based on code from Peter Norvig's book,
// Paradigms of Artificial Intelligence Programming.

/// global state

var globals = {};
var macros = {};
var prims = {};
var procs = {};
var queue = [];
var currentproc = null;
var timeoutheap = null;

var cyclecount = 0;
var deaths = [];

/// lisp types

var symbolp = function(x) {
	return typeof(x) == "string";
};

var numberp = function(x) {
	return typeof(x) == "number";
};

var stringp = function(x) {
	return x.type == "string";
};
var string = function(value) {
	this.value = value;
};
string.prototype = {
	type: "string"
};

var nilp = function(x) {
	return x === nil;
};
var nil = {type: "nil"};

var consp = function(x) {
	return x.type == "cons";
};
var cons = function(a, b) {
	this.car = a;
	this.cdr = b;
};
cons.prototype = {
	type: "cons"
};

var funcp = function(x) {
	return x.type == "func";
};
var func = function(code) {
	this.code = code;
	this.env = nil;
};
func.prototype = {
	type: "func"
};

/// primitive lisp data accessors

var symbolname = function(x) {
	if (!symbolp(x)) {
		throw "symbolname: type error";
	}
	return new string(x);
};

var car = function(x) {
	if (!consp(x)) {
		throw "car: type error";
	}
	return x.car;
};

var cdr = function(x) {
	if (!consp(x)) {
		throw "cdr: type error";
	}
	return x.cdr;
};

var setcar = function(c, x) {
	if (!consp(c)) {
		throw "setcar: type error";
	}
	c.car = x;
	return x;
};

var setcdr = function(c, x) {
	if (!consp(c)) {
		throw "setcdr: type error";
	}
	c.cdr = x;
	return x;
};

var closure = function(f, env) {
	var c;
	c = new func(f.code);
	c.env = env;
	return c;
};

/// common list functions

var first = car;

var second = function(x) {
	return car(cdr(x));
};

var third = function(x) {
	return car(cdr(cdr(x)));
};

var list = function() {
	var i, x;
	x = nil;
	for (i = arguments.length - 1; i >= 0; i--) {
		x = new cons(arguments[i], x);
	}
	return x;
};

var reverse = function(x) {
	var acc;
	for (acc = nil; !nilp(x); x = cdr(x)) {
		acc = new cons(car(x), acc);
	}
	return acc;
};

var map = function(x, f) {
	var fx;
	for (fx = nil; !nilp(x); x = cdr(x)) {
		fx = new cons(f(car(x)), fx);
	}
	return reverse(fx);
};

var foreach = function(x, f) {
	for (; !nilp(x); x = cdr(x)) {
		f(car(x));
	}
};

var array = function(x) {
	var a;
	for (a = []; !nilp(x); x = cdr(x)) {
		a.push(car(x));
	}
	return a;
};

/// interpreter

var finalret = function() {
	return {
		f: new func([
			new POP(),
			new CONST("normal"),
			new HALT()
		]),
		pc: 0,
		env: nil
	};
};

var machine = function(f) {
	this.f = f;
	this.code = f.code;
	this.pc = 0;
	this.env = f.env;
	this.stack = [finalret()];
	this.nargs = 0;
	this.status = "running";
	this.run = function(quota) {
		var instr, ncycles, exn = null;
		try {
			for (ncycles = 0; ncycles < quota; ncycles++) {
				instr = this.code[this.pc];
				this.pc++;
				instr.update(this);
				if (this.status != "running") {
					break;
				}
			}
		} catch (e) {
			exn = e;
		}
		return {ncycles: ncycles, exn: exn};
	};
	this.recv = function(recvfn, args) {
		var self = this;
		if (this.status != "waiting") {
			throw "machine recv: not waiting for message";
		}
		this.nargs = 0;
		foreach(args, function(arg) {
			self.stack.push(arg);
			self.nargs++;
		});
		this.f = closure(recvfn, this.env);
		this.code = recvfn.code;
		this.pc = 0;
		this.status = "running";
	};
	this.top = function() {
		return this.stack[this.stack.length - 1];
	};
	this.frame = function(i) {
		var tail;
		for (tail = this.env; i > 0; i--) {
			tail = cdr(tail);
		}
		return car(tail);
	};
	this.snapshot = function() {
		var i, n, x, ret;
		n = this.stack.length;
		x = list(
			list("env", unboxenv(this.env)),
			list("f", this.f),
			list("pc", this.pc)
		);
		for (i = 0; i < n; i++) {
			if (typeof(this.stack[i]) != "object") {
				continue;
			}
			if ("pc" in this.stack[i]) {
				ret = this.stack[i];
				x = new cons(list(
					"ret", ret.pc, ret.f,
					unboxenv(ret.env)
				), x);
			}
		}
		return x;
	};
};

var ARGS = function(nargs) {
	this.nargs = nargs;
};
ARGS.prototype = {
	op: "ARGS",
	update: function(m) {
		var i, frame = [];
		if (m.nargs != this.nargs) {
			throw "wrong number of arguments";
		}
		frame.length = m.nargs;
		for (i = m.nargs - 1; i >= 0; i--) {
			frame[i] = m.stack.pop();
		}
		m.env = new cons(frame, m.env);
	},
	sexp: function() {
		return list("ARGS", this.nargs);
	}
};

var ARGSD = function(nargs) {
	this.nargs = nargs;
};
ARGSD.prototype = {
	op: "ARGSD",
	update: function(m) {
		var i, frame = [], rnargs;
		if (m.nargs < this.nargs) {
			throw "too few arguments";
		}
		rnargs = this.nargs;
		frame.length = rnargs + 1;
		frame[rnargs] = nil;
		for (i = m.nargs; i > rnargs; i--) {
			frame[rnargs] = new cons(m.stack.pop(), frame[rnargs]);
		}
		for (i = rnargs - 1; i >= 0; i--) {
			frame[i] = m.stack.pop();
		}
		m.env = new cons(frame, m.env);
	},
	sexp: function() {
		return list("ARGSD", this.nargs);
	}
};

var LVAR = function(i, j, name) {
	this.i = i;
	this.j = j;
	this.name = name;
};
LVAR.prototype = {
	op: "LVAR",
	update: function(m) {
		m.stack.push(m.frame(this.i)[this.j]);
	},
	sexp: function() {
		return list("LVAR", this.i, this.j, this.name);
	}
};

var LSET = function(i, j, name) {
	this.i = i;
	this.j = j;
	this.name = name;
};
LSET.prototype = {
	op: "LSET",
	update: function(m) {
		m.frame(this.i)[this.j] = m.top();
	},
	sexp: function() {
		return list("LSET", this.i, this.j, this.name);
	}
};

var GVAR = function(name) {
	this.name = name;
};
GVAR.prototype = {
	op: "GVAR",
	update: function(m) {
		if (this.name in globals) {
			m.stack.push(globals[this.name]);
			return;
		}
		throw "undefined global: " + this.name;
	},
	sexp: function() {
		return list("GVAR", this.name);
	}
};

var GSET = function(name) {
	this.name = name;
};
GSET.prototype = {
	op: "GSET",
	update: function(m) {
		if (this.name in globals) {
			globals[this.name] = m.top();
			return;
		}
		throw "undefined global: " + this.name;
	},
	sexp: function() {
		return list("GSET", this.name);
	}
};

var POP = function() {
};
POP.prototype = {
	op: "POP",
	update: function(m) {
		m.stack.pop();
	},
	sexp: function() {
		return list("POP");
	}
};

var CONST = function(value) {
	this.value = value;
};
CONST.prototype = {
	op: "CONST",
	update: function(m) {
		m.stack.push(this.value);
	},
	sexp: function() {
		return list("CONST", this.value);
	}
};

var JUMP = function(label, pc) {
	this.label = label;
	this.pc = pc;
};
JUMP.prototype = {
	op: "JUMP",
	update: function(m) {
		m.pc = this.pc;
	},
	sexp: function() {
		return list("JUMP", this.label, this.pc);
	}
};

var FJUMP = function(label, pc) {
	this.label = label;
	this.pc = pc;
};
FJUMP.prototype = {
	op: "FJUMP",
	update: function(m) {
		if (nilp(m.stack.pop())) {
			m.pc = this.pc;
		}
	},
	sexp: function() {
		return list("FJUMP", this.label, this.pc);
	}
};

var TJUMP = function(label, pc) {
	this.label = label;
	this.pc = pc;
};
TJUMP.prototype = {
	op: "TJUMP",
	update: function(m) {
		if (!nilp(m.stack.pop())) {
			m.pc = this.pc;
		}
	},
	sexp: function() {
		return list("TJUMP", this.label, this.pc);
	}
};

var SAVE = function(label, pc) {
	this.label = label;
	this.pc = pc;
};
SAVE.prototype = {
	op: "SAVE",
	update: function(m) {
		m.stack.push({
			f: m.f,
			env: m.env,
			pc: this.pc
		});
	},
	sexp: function() {
		return list("SAVE", this.label, this.pc);
	}
};

var RETURN = function() {
};
RETURN.prototype = {
	op: "RETURN",
	update: function(m) {
		var val, ret;
		val = m.stack.pop();
		ret = m.stack.pop();
		m.f = ret.f;
		m.code = ret.f.code;
		m.env = ret.env;
		m.pc = ret.pc;
		m.stack.push(val);
	},
	sexp: function() {
		return list("RETURN");
	}
};

var CALLJ = function(nargs) {
	this.nargs = nargs;
};
CALLJ.prototype = {
	op: "CALLJ",
	update: function(m) {
		var args;
		m.f = m.stack.pop();
		if (!("env" in m.f)) {
			throw "cannot call closure function";
		}
		m.nargs = this.nargs;
		if (m.nargs == -1) {
			args = m.stack.pop();
			for (m.nargs = 0; !nilp(args); m.nargs++) {
				m.stack.push(car(args));
				args = cdr(args);
			}
		}
		m.code = m.f.code;
		m.env = m.f.env;
		m.pc = 0;
	},
	sexp: function() {
		return list("CALLJ", this.nargs);
	}
};

var FN = function(f) {
	this.f = f;
};
FN.prototype = {
	op: "FN",
	update: function(m) {
		m.stack.push(closure(this.f, m.env));
	},
	sexp: function() {
		return list("FN", this.f);
	}
};

var genarglist = function(args) {
	var s;
	if (nilp(args)) {
		return "";
	}
	s = car(args);
	foreach(cdr(args), function(arg) {
		s += ", " + arg;
	});
	return s;
};

var collectoptargs = function(m, n) {
	var i, x = nil;
	for (i = 0; i < n; i++) {
		x = new cons(m.stack.pop(), x);
	}
	return x;
};

var genprim = function(name) {
	var req, opt, body, arglist;
	if (name === "") {
		primlog(new string("empty prim name"));
	}
	req = prims[name].req;
	opt = prims[name].opt;
	body = "";
	arglist = genarglist(req);
	if (opt !== null) {
		if (!nilp(req)) {
			arglist += ", ";
		}
		arglist += opt;
	}
	if (arglist !== "") {
		body += "	var " + arglist + ";\n";
	}
	if (opt !== null) {
		body += "	" + opt + " = collectoptargs(_m, _m.nargs - " +
			array(req).length + ");\n";
	}
	foreach(reverse(req), function(arg) {
		body += "	" + arg + " = _m.stack.pop();\n";
	});
	body += "	_m.stack.push(prim" + name + "(" + arglist + "));\n";
	return "(function (_m) {\n" + body + "})\n";
};

var compiledprim = function(name) {
	return eval(genprim(name));
};

var PRIM = function(name) {
	this.name = name;
	this.update = compiledprim(name);
};
PRIM.prototype = {
	op: "PRIM",
	sexp: function() {
		return list("PRIM", this.name);
	}
};

var HALT = function() {
};
HALT.prototype = {
	op: "HALT",
	update: function(m) {
		currentproc.die(m.top());
	},
	sexp: function() {
		return list("HALT");
	}
};

var RECV = function(r, timeout) {
	this.receivers = r;
	this.timeout = timeout;
};
RECV.prototype = {
	op: "RECV",
	update: function(m) {
		currentproc.receivers = this.receivers;
		if (this.timeout) {
			currentproc.settimeout(
				this.timeout.ms,
				this.timeout.f
			);
		}
		m.status = "waiting";
	},
	sexp: function() {
		var rs = nil, timeout = nil;
		if (this.timeout !== null) {
			timeout = list(this.timeout.ms, this.timeout.f);
		}
		for (tag in this.receivers) {
			rs = new cons(list(tag, this.receivers[tag]), rs);
		}
		return list("RECV", rs, timeout);
	}
};

/// code format

var boxinstr = (function() {
	var construct;
	construct = function(op, args) {
		var f;
		f = function() {
			return window[op].apply(this, args);
		};
		f.prototype = window[op].prototype;
		return new f();
	};
	return function(x) {
		var instr, tab, timeout;
		instr = construct(car(x), array(cdr(x)));
		if (instr instanceof FN) {
			instr.f = boxfn(instr.f);
		} else if (instr instanceof RECV) {
			tab = {};
			timeout = null;
			foreach(instr.receivers, function(r) {
				tab[first(r)] = boxfn(second(r));
			});
			if (instr.timeout && !nilp(instr.timeout)) {
				timeout = {
					ms: first(instr.timeout),
					f: boxfn(second(instr.timeout))
				};
			}
			instr.receivers = tab;
			instr.timeout = timeout;
		}
		return instr;
	};
})();

var unboxinstr = function(x) {
	return x.sexp();
};

var boxfn = function(x) {
	var code, instrs;
	if (funcp(x)) {
		return x;
	}
	foreach(x, function(pair) {
		switch (first(pair)) {
		case "code":
			instrs = second(pair);
			break;
		default:
			throw "boxfn: unexpected slot";
		}
	});
	code = array(map(instrs, boxinstr));
	return new func(code);
};

var unboxfn = function(f) {
	var instrs;
	if (!funcp(f)) {
		throw "unboxfn: type error";
	}
	instrs = list.apply(null, f.code);
	return list(
		list("code", map(instrs, unboxinstr))
	);
};

var unboxenv = function(env) {
	return map(env, function(a) {
		return list.apply(null, a);
	});
};

/// loading

var fromjson = function(x) {
	var e, i, n;
	if (typeof(x) == "number") {
		return x;
	}
	if (typeof(x) == "string") {
		return x;
	}
	if ("s" in x) {
		return new string(x.s);
	}
	if ("d" in x) {
		n = x.d.length;
		e = fromjson(x.d[n - 1]);
		for (i = n - 2; i >= 0; i--) {
			e = new cons(fromjson(x.d[i]), e);
		}
		return e;
	}
	n = x.length;
	e = nil;
	for (i = n - 1; i >= 0; i--) {
		e = new cons(fromjson(x[i]), e);
	}
	return e;
};

var loadjson = function(json, i) {
	var f, pid;
	if (i == json.length) {
		return;
	}
	f = boxfn(fromjson(json[i]));
	pid = primspawn(f);
	procs[pid].sequencehook = function() {
		loadjson(json, i + 1);
	};
};

var load = function() {
	primlog(new string("loading boot.fasl"));
	xhrgets("boot.fasl", function(text) {
		loadjson(eval(text), 0);
	});
};

/// browser event functions

var eventsexp = function(e) {
	switch (e.type) {
	case "keyup":
	case "keydown":
		return list(e.type, e.keyCode);
	case "mousemove":
		return list("mousemove");
	case "click":
		if (!("id" in e.target)) {
			throw "eventsexp: unknown id";
		}
		return list("click", e.target.id);
	case "change":
		if (!("id" in e.target)) {
			throw "eventsexp: unknown id";
		}
		return list("change", e.target.id, new string(e.target.value));
	default:
		throw "eventsexp: unknown event type";
	}
};

/// concurrency

var message = function(p, msg) {
	this.p = p;
	this.msg = msg;
};
message.prototype.type = "message";

var messagep = function(x) {
	return x.type == "message";
};

var sendmsg = function(p, msg) {
	queue.push(new message(p, msg));
};

var newpid = (function() {
	var savedmaxvalue, randint;
	savedmaxvalue = 8;
	randint = function(max) {
		return Math.floor(Math.random() * max);
	};
	return function() {
		var pid, maxvalue, ntries;
		maxvalue = Math.max(8, savedmaxvalue / 2);
		for (; true; maxvalue *= 2) {
			for (ntries = 0; ntries < 4; ntries++) {
				pid = "p" + randint(maxvalue);
				if (!(pid in procs)) {
					break;
				}
			}
			if (ntries < 4) {
				break;
			}
		}
		savedmaxvalue = maxvalue;
		return pid;
	};
})();

var minheap = function(lessp) {
	this.items = [null];
	this.emptyp = function() {
		return this.items.length == 1;
	};
	this.min = function() {
		return this.items[1];
	};
	this.insert = function(item) {
		this.items.push(item);
		this.fixup();
	};
	this.pop = function() {
		var min;
		min = this.items[1];
		if (this.items.length == 2) {
			this.items.pop();
		} else {
			this.items[1] = this.items.pop();
			this.fixdown();
		}
		return min;
	};
	this.fixup = function() {
		var x, i, tmp;
		x = this.items;
		for (i = x.length - 1; i > 1; i = j) {
			j = Math.floor(i / 2);
			if (!lessp(x[i], x[j])) {
				break;
			}
			tmp = x[i];
			x[i] = x[j];
			x[j] = tmp;
		}
	};
	this.fixdown = function() {
		var x, n, i, j, tmp;
		x = this.items;
		n = x.length - 1;
		for (i = 1; 2 * i <= n; i = j) {
			j = 2 * i;
			if (j < n && lessp(x[j + 1], x[j])) {
				j++;
			}
			if (!lessp(x[j], x[i])) {
				break;
			}
			tmp = x[i];
			x[i] = x[j];
			x[j] = tmp;
		}
	};
};

var proc = function(pid, f) {
	this.pid = pid;
	this.m = new machine(f);
	this.receivers = {};
	this.savequeue = [];
	this.mailbox = [];
	this.linkset = [];
	this.trapexitsp = false;
	this.sequencehook = null;
	this.timeout = null;
	this.link = function(p) {
		this.linkset.push(p);
		p.linkset.push(this);
	};
	this.die = function(reason) {
		var i, n, p;
		if (this.m.status == "halted") {
			return;
		}
		deaths.push(reason);
		this.m.status = "halted";
		delete procs[this.pid];
		n = this.linkset.length;
		for (i = 0; i < n; i++) {
			p = this.linkset[i];
			if (p.trapexitsp) {
				sendmsg(p, list(
					"exit",
					this.pid,
					this.m.snapshot(),
					reason
				));
				continue;
			}
			if (reason != "normal") {
				p.die(reason); // XXX stack overflow?
			}
		}
		if (this.sequencehook !== null) {
			this.sequencehook();
		}
	};
	this.kill = function() {
		this.die("killed");
	};
	this.checkmail = function() {
		var msg, tag;
		if (this.m.status != "waiting") {
			throw "proc checkmail: not waiting";
		}
		while (this.mailbox.length > 0) {
			msg = this.mailbox.shift();
			tag = car(msg);
			if (tag in this.receivers) {
				if (this.timeout !== null) {
					this.timeout.canceled = true;
					this.timeout = null;
				}
				while (this.savequeue.length > 0) {
					queue.push(this.savequeue.shift());
				}
				this.m.recv(this.receivers[tag], cdr(msg));
				return;
			}
			this.savequeue.push(new message(this, msg));
		}
	};
	this.run = function(quota) {
		var state;
		if (this.m.status != "running") {
			return 0;
		}
		state = this.m.run(quota);
		cyclecount += state.ncycles;
		if (state.exn !== null) {
			this.die(new string("exception: " + state.exn));
		}
		if (this.m.status == "waiting") {
			this.checkmail();
		}
		return state.ncycles;
	};
	this.recv = function(msg) {
		this.mailbox.push(msg);
		if (this.m.status == "waiting") {
			this.checkmail();
		}
	};
	this.expiretimeout = function() {
		var timeout;
		if (this.timeout === null) {
			return;
		}
		if (this.m.status != "waiting") {
			return;
		}
		this.checkmail();
		if (this.m.status != "waiting") {
			return;
		}
		timeout = this.timeout;
		this.timeout = null;
		while (this.savequeue.length > 0) {
			queue.push(this.savequeue.shift());
		}
		this.m.recv(timeout.f, nil);
	};
	this.settimeout = function(ms, f) {
		this.timeout = {
			p: this,
			ms: now() + ms,
			f: f,
			canceledp: false
		};
		timeoutheap.insert(this.timeout);
	};
};

var reschedule = function(p) {
	switch (p.m.status) {
	case "running":
		queue.push(p.pid);
		break;
	case "halted":
	case "waiting":
		break;
	default:
		throw "reschedule: unexpected status";
	}
};

var now = function() {
	return (new Date()).getTime();
};

var withcurrentproc = function(p, f) {
	currentproc = p;
	try {
		f();
		reschedule(currentproc);
	} finally {
		currentproc = null;
	}
};

var schedulingp = false;

var enablescheduling = function() {
	if (!schedulingp) {
		setTimeout(scheduler, 0);
	}
};

var schedsafe = function() {
	schedulingp = true;
	try {
		schedunsafe();
	} finally {
		schedulingp = false;
	}
};

var schedunsafe = function() {
	var begin, task, p, timeout;
	begin = now();
	while (now() - begin < 20) {
		if (!timeoutheap.emptyp()) {
			timeout = timeoutheap.min();
			if (timeout.canceledp) {
				timeoutheap.pop();
				continue;
			}
			if (now() >= timeout.ms) {
				timeoutheap.pop();
				withcurrentproc(timeout.p, function() {
					currentproc.expiretimeout();
				});
				continue;
			}
		}
		if (queue.length == 0) {
			break;
		}
		task = queue.shift();
		if (symbolp(task)) {
			if (!(task in procs)) {
				continue;
			}
			p = procs[task];
			withcurrentproc(p, function() {
				currentproc.run(100);
			});
			continue;
		}
		if (messagep(task)) {
			withcurrentproc(task.p, function() {
				currentproc.recv(task.msg);
			});
			continue;
		}
		throw "scheduler: unexpected task";
	}
	if (queue.length > 0) {
		setTimeout(scheduler, 0);
		return;
	}
	if (!timeoutheap.emptyp()) {
		timeout = timeoutheap.min();
		setTimeout(scheduler, timeout.ms - now());
		return;
	}
};

var scheduler = schedsafe;

/// primitives

var truth = function(x) {
	return x ? "t" : nil;
};

var predicate = function(f) {
	return function(x) {
		return truth(f(x));
	};
};

var mustbe = function(pred, x) {
	if (!pred(x)) {
		throw "type error";
	}
};

var bothmustbe = function(pred, a, b) {
	mustbe(pred, a);
	mustbe(pred, b);
};

var primadd = function(a, b) { bothmustbe(numberp, a, b); return a + b; };
var primsub = function(a, b) { bothmustbe(numberp, a, b); return a - b; };
var primmul = function(a, b) { bothmustbe(numberp, a, b); return a * b; };
var primdiv = function(a, b) { bothmustbe(numberp, a, b); return a / b; };

var primsqrt = function(a) {
	mustbe(numberp, a);
	return Math.sqrt(a);
};

var primsin = function(a) {
	mustbe(numberp, a);
	return Math.sin(a);
};

var primcos = function(a) {
	mustbe(numberp, a);
	return Math.cos(a);
};

var primdef = function(sym) {
	if (sym in globals) {
		return;
	}
	globals[sym] = sym;
	return sym;
};

var primundef = function(sym) {
	delete globals[sym];
	return sym;
};

var primmac = function(sym) {
	macros[sym] = true;
	return sym;
};

var primunmac = function(sym) {
	delete macros[sym];
	return sym;
};

var primlt = function(a, b) { bothmustbe(numberp, a, b); return truth(a < b); };
var primgt = function(a, b) { bothmustbe(numberp, a, b); return truth(a > b); };
var primle = function(a, b) { bothmustbe(numberp, a, b); return truth(a <= b); };
var primge = function(a, b) { bothmustbe(numberp, a, b); return truth(a >= b); };

var primeq = function(a, b) {
	if (stringp(a) && stringp(b)) {
		return truth(a.value === b.value);
	}
	return truth(a === b);
};

var primneq = function(a, b) {
	if (stringp(a) && stringp(b)) {
		return truth(a.value !== b.value);
	}
	return truth(a !== b);
};

var primsymbolp = predicate(symbolp);
var primnumberp = predicate(numberp);
var primstringp = predicate(stringp);
var primconsp = predicate(consp);
var primfunctionp = predicate(funcp);

var primsymbolname = symbolname;
var primcons = function(a, b) { return new cons(a, b); };
var primcar = car;
var primcdr = cdr;
var primsetcar = setcar;
var primsetcdr = setcdr;

var primsubstringp = function(sub, str) {
	var substringp;
	substringp = function(a, b) {
		return b.indexOf(a, 0) != -1;
	};
	bothmustbe(stringp, sub, str);
	return truth(substringp(sub.value, str.value));
};

var primsref = function(s, i) {
	mustbe(stringp, s);
	mustbe(numberp, i);
	if (i < 0 || s.value.length <= i) {
		throw "sref: bad index";
	}
	return new string(s.value[i]);
};

var primslength = function(s) {
	mustbe(stringp, s);
	return s.value.length;
};

var primstrcat = function(args) {
	var s;
	s = "";
	foreach(args, function(arg) {
		mustbe(stringp, arg);
		s += arg.value;
	});
	return new string(s);
};

var primsubstring = function(s, begin, end) {
	mustbe(stringp, s);
	return new string(s.value.substring(begin, end));
};

var primatoi = function(a) {
	var n;
	mustbe(stringp, a);
	n = Number(a.value);
	if (isNaN(n)) {
		return nil;
	}
	return n;
};

var primitoa = function(i) {
	mustbe(numberp, i);
	return new string("" + i);
};

var primintern = function(s) {
	mustbe(stringp, s);
	return s.value;
};

var primthrow = function(x) {
	mustbe(stringp, x);
	throw x.value;
};

var primglobal = function(name) {
	if (name in globals) {
		return globals[name];
	}
	throw "undefined global";
};

var primmacrop = function(name) {
	return truth(name in macros);
};

var primshowglobals = function() {
	var name;
	for (name in globals) {
		primlog(new string(name));
	}
	return nil;
};

var primboxfn = boxfn;
var primunboxfn = unboxfn;

var primlog = function(msg) {
	var node;
	mustbe(stringp, msg);
	node = $("textout")
	node.value += msg.value + "\n";
	node.scrollTop = node.scrollHeight;
	return nil;
};

var primsnapshot = function(pid) {
	mustbe(symbolp, pid);
	if (!(pid in procs)) {
		throw "snapshot: no such process";
	}
	return procs[pid].m.snapshot();
};

var colortab = {
	lred: "#a59494",
	dred: "#8f403d",
	lgreen: "#dee6ce",
	dgreen: "#949a8a",
	lblue: "rgba(179,193,194,0.3)", //"#b3c1c2",
	dblue: "#728485"
};

var withcontext = function(f) {
	f($("canvas").getContext("2d"));
};

var drawcmds = [];

var primdraw = function() {
	var i, n, cmd, context;
	context = $("canvas").getContext("2d");
	n = drawcmds.length;
	for (i = 0; i < n; i++) {
		cmd = drawcmds[i];
		switch (drawcmds[i][0]) {
		case "box":
			context.fillStyle = cmd[1];
			context.fillRect.apply(context, cmd[2]);
			break;
		case "circle":
			context.fillStyle = cmd[1];
			context.beginPath();
			context.arc(cmd[2][0], cmd[2][1], 10,
				0, 2 * Math.PI, false);
			context.fill();
			break;
		case "beginpath":
			context.beginPath();
			break;
		case "moveto":
			context.moveTo.apply(context, cmd[1]);
			break;
		case "lineto":
			context.lineTo.apply(context, cmd[1]);
			break;
		case "fill":
			context.fillStyle = colortab["lred"];
			context.fill();
			break;
		case "linewidth":
			context.lineWidth = cmd[1];
			break;
		case "stroke":
			context.strokeStyle = cmd[1];
			context.stroke();
			break;
		default:
			throw "draw: unknown command";
		}
	}
	drawcmds.length = 0;
	return nil;
};

var primbox = function(color, x, y, w, h) {
	mustbe(symbolp, color);
	bothmustbe(numberp, x, y);
	bothmustbe(numberp, w, h);
	if (!(color in colortab)) {
		throw "box: unknown color";
	}
	drawcmds.push(["box", colortab[color], [x, y, w, h]]);
	return nil;
};

var primcircle = function(color, x, y) {
	mustbe(symbolp, color);
	bothmustbe(numberp, x, y);
	if (!(color in colortab)) {
		throw "circle: unknown color";
	}
	drawcmds.push(["circle", colortab[color], [x, y]]);
	return nil;
};

var primbeginpath = function() {
	drawcmds.push(["beginpath"]);
	return nil;
};

var primmoveto = function(x, y) {
	bothmustbe(numberp, x, y);
	drawcmds.push(["moveto", [x, y]]);
	return nil;
};

var primlineto = function(x, y) {
	bothmustbe(numberp, x, y);
	drawcmds.push(["lineto", [x, y]]);
	return nil;
};

var primfill = function() {
	drawcmds.push(["fill"]);
	return nil;
};

var primstroke = function(color) {
	mustbe(symbolp, color);
	if (!(color in colortab)) {
		throw "stroke: unknown color";
	}
	drawcmds.push(["stroke", colortab[color]]);
	return nil;
};

var primlinewidth = function(w) {
	mustbe(numberp, w);
	drawcmds.push(["linewidth", w]);
	return nil;
};

var primtext = function(color, text, x, y) {
	var canvas, context;
	mustbe(symbolp, color);
	mustbe(stringp, text);
	bothmustbe(numberp, x, y);
	if (!(color in colortab)) {
		throw "text: unknown color";
	}
	canvas = $("canvas");
	context = canvas.getContext("2d");
	context.font = "20px courier";
	context.fillStyle = colortab[color];
	context.fillText(text.value, x, y);
	return nil;
};

var primspawn = function(f) {
	var pid;
	mustbe(funcp, f);
	pid = newpid();
	procs[pid] = new proc(pid, f);
	queue.push(pid);
	enablescheduling();
	return pid;
};

var primspawnlink = function(f) {
	var pid;
	mustbe(funcp, f);
	pid = primspawn(f);
	procs[pid].link(currentproc);
	enablescheduling();
	return pid;
};

var primtrapexits = function() {
	if (!currentproc) {
		throw "trapexits: no current process";
	}
	currentproc.trapexitsp = true;
	return nil;
};

var primsendmsg = function(pid, msg) {
	mustbe(symbolp, pid);
	mustbe(consp, msg);
	mustbe(symbolp, car(msg));
	if (!(pid in procs)) {
		throw "sendmsg: no such process";
	}
	sendmsg(procs[pid], msg);
	return nil;
};

var primself = function() {
	return currentproc.pid;
};

var primprocs = function() {
	var pid, x = nil;
	for (pid in procs) {
		x = new cons(list(pid, procs[pid].m.status), x);
	}
	return x;
};

var primkill = function(pid) {
	mustbe(symbolp, pid);
	if (!(pid in procs)) {
		throw "kill: no such process";
	}
	procs[pid].kill();
	return nil;
};

var xhrgets = function(url, f) {
	var xhr;
	xhr = new XMLHttpRequest();
	xhr.open("GET", url, true);
	xhr.onreadystatechange = function(e) {
		if (xhr.readyState == 4) {
			if (xhr.status == 200) {
			        f(xhr.responseText);
				return;
			}
			throw "xhrgets: network error";
		}
	};
	xhr.send(null);
};

var xhrputs = function(url, text, f) {
	var xhr;
	xhr = new XMLHttpRequest();
	xhr.open("PUT", url, true);
	xhr.onreadystatechange = function(e) {
		if (xhr.readyState == 4) {
			if (xhr.status == 200) {
			        f();
				return;
			}
			throw "xhrputs: network error";
		}
	};
	xhr.send(text);
};

var primhttp = function(method, url, args) {
	var p;
	mustbe(symbolp, method);
	mustbe(stringp, url);
	p = currentproc;
	switch (method) {
	case "get":
		if (!nilp(args)) {
			throw "net: wrong number of arguments";
		}
		xhrgets(url.value, function(text) {
			queue.push(new message(
				p, list("response", 200, new string(text))
			));
			enablescheduling();
		});
		break;
	case "put":
		if (!nilp(cdr(args))) {
			throw "net: wrong number of arguments";
		}
		mustbe(stringp, car(args));
		xhrputs(url.value, car(args).value, function() {
			queue.push(new message(
				p, list("response", 200)
			));
			enablescheduling();
		});
		break;
	default:
		throw "net: unknown method";
	}
	return nil;
};

var postlistener = function(node, event) {
	var f, p;
	mustbe(symbolp, event);
	p = currentproc;
	f = function(e) {
		queue.push(new message(p, eventsexp(e)));
		enablescheduling();
	};
	node.addEventListener(event, f, false);
};

var primdoc = function(req) {
	var method, resource, body, node;
	method = first(req);
	resource = second(req);
	body = nil;
	if (consp(cdr(cdr(req)))) {
		body = third(req);
	}
	mustbe(symbolp, method);
	mustbe(consp, resource);
	mustbe(symbolp, car(resource));
	mustbe(consp, cdr(resource));
	mustbe(symbolp, second(resource));
	if (car(resource) == "body") {
		node = document;
	} else {
		node = $(car(resource));
	}
	if (!node) {
		throw "doc: no such resource";
	}
	switch (method) {
	case "get":
		if (second(resource) == "value") {
			return new string(node.value);
		}
		throw "doc: no such resource";
	case "put":
		if (second(resource) == "value") {
			mustbe(stringp, body);
			node.value = body.value;
			return nil;
		}
		throw "doc: no such resource";
	case "post":
		switch (second(resource)) {
		case "value":
			mustbe(stringp, body);
			node.value += body.value;
			return nil;
		case "listeners":
			postlistener(node, body);
			return nil;
		}
		throw "doc: no such resource";
	case "create":
	case "delete":
		break;
	default:
		throw "doc: unknown method";
	}
};

var primfocus = function(id) {
	var node;
	mustbe(symbolp, id);
	node = $(id);
	if (node) {
		node.focus();
	}
	return nil;
};

var primblur = function(id) {
	var node;
	mustbe(symbolp, id);
	node = $(id);
	if (node) {
		node.blur();
	}
	return nil;
};

var primfromjson = function(s) {
	mustbe(stringp, s);
	return fromjson(eval(s.value));
};

var primrand = function() {
	return Math.random();
};

var primfloor = function(n) {
	mustbe(numberp, n);
	return Math.floor(n);
};

var fprimrenames = {
	"+": "add",
	"-": "sub",
	"*": "mul",
	"/": "div",
	"<": "lt",
	">": "gt",
	"<=": "le",
	">=": "ge",
	"=": "eq",
	"!=": "neq"
};

var fprims = [
	"+ a b",
	"- a b",
	"* a b",
	"/ a b",
	"sqrt a",
	"cos a",
	"sin a",
	"< a b",
	"> a b",
	"<= a b",
	">= a b",
	"= a b",
	"!= a b",
	"numberp x",
	"symbolp x",
	"consp x",
	"functionp x",
	"stringp x",
	"symbolname sym",
	"cons a b",
	"car c",
	"cdr c",
	"setcar x value",
	"setcdr x value",
	"def sym",
	"undef sym",
	"mac sym",
	"unmac sym",
	"symbolp x",
	"strcat . strings",
	"substringp sub str",
	"sref s i",
	"slength s",
	"substring s a z",
	"atoi a",
	"itoa i",
	"intern s",
	"throw x",
	"global name",
	"macrop name",
	"showglobals",
	"boxfn alist",
	"unboxfn f",
	"log msg",
	"snapshot name",
	"draw",
	"box color x y w h",
	"circle color x y",
	"beginpath",
	"moveto x y",
	"lineto x y",
	"fill",
	"stroke color",
	"linewidth w",
	"text color str x y",
	"spawn f",
	"spawnlink f",
	"trapexits",
	"sendmsg pid msg",
	"self",
	"procs",
	"kill pid",
	"http method url . args",
	"doc . req",
	"focus id",
	"blur id",
	"fromjson s",
	"rand",
	"floor n"
];

var mprims = [
	["exit reason", [
		new ARGS(1),
		new LVAR(0, 0, "reason"),
		new HALT()
	]],
	["apply f args", [
		new ARGS(2),
		new LVAR(0, 1, "args"),
		new LVAR(0, 0, "f"),
		new CALLJ(-1)
	]]
];

var initlisp = (function() {
	var done;
	done = false;
	return function() {
		if (done) {
			return;
		}
		loadfprims();
		loadmprims();
		globals["t"] = "t";
		globals["pi"] = Math.PI;
		done = true;
	};
})();

var readargs = function(s) {
	var x, atoms, i, n;
	x = nil;
	atoms = s.split(" ");
	n = atoms.length;
	if (n >= 3) {
		if (atoms[n - 2] == ".") {
			x = atoms[n - 1];
			n -= 2;
		}
	}
	for (i = n - 1; i >= 0; i--) {
		x = new cons(atoms[i], x);
	}
	return x;
};

var loadfprims = function() {
	// put fprims onto the end of mprims
	var i, n, f, r, form, name, args, prim;
	n = fprims.length;
	for (i = 0; i < n; i++) {
		form = readargs(fprims[i]);
		name = first(form);
		args = cdr(form);
		prim = {req: nil, opt: null};
		for (; consp(args); args = cdr(args)) {
			prim.req = new cons(car(args), prim.req);
		}
		prim.req = reverse(prim.req);
		if (!nilp(args)) {
			prim.opt = args;
		}
		if (name in fprimrenames) {
			name = fprimrenames[name];
		}
		prims[name] = prim;
		mprims.push([
			fprims[i],
			[
				new PRIM(name),
				new RETURN()
			]
		]);
	}
};

var loadmprims = function() {
	var i, n, r, form, code, name, args;
	n = mprims.length;
	for (i = 0; i < n; i++) {
		form = readargs(mprims[i][0]);
		code = mprims[i][1];
		name = first(form);
		args = cdr(form);
		globals[name] = new func(code);
	}
};

/// browser goodies

var $ = function(x) {
	return document.getElementById(x);
};

/// setup

var setglobals = function() {
	timeoutheap = new minheap(function(a, b) {
		return a.ms < b.ms;
	});
};

initlisp();
setglobals();
load();