awk: add seq and string?

awk: add seq and string?

Issue #166

@load "readfile"
@load "time"

function core_eq_sub(lhs, rhs,    i, len)
{
	if (lhs ~ /^[([]/ && rhs ~ /^[([]/) {
		lhs = substr(lhs, 2)
		rhs = substr(rhs, 2)
		len = types_heap[lhs]["len"]
		if (len != types_heap[rhs]["len"]) {
			return 0
		}
		for (i = 0; i < len; ++i) {
			if (!core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) {
				return 0
			}
		}
		return 1
	} else if (lhs ~ /^\{/ && rhs ~ /^\{/) {
		lhs = substr(lhs, 2)
		rhs = substr(rhs, 2)
		if (length(types_heap[lhs]) != length(types_heap[rhs])) {
			return 0
		}
		for (i in types_heap[lhs]) {
			if (types_heap[lhs][i] ~ /^["':+#([{?&$%]/ &&
				!core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) {
				return 0
			}
		}
		return 1
	} else {
		return lhs == rhs
	}
}

function core_eq(idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return core_eq_sub(types_heap[idx][1], types_heap[idx][2]) ? "#true" : "#false"
}

function core_throw(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'throw'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return "!" types_addref(types_heap[idx][1])
}

function core_nilp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'nil?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] == "#nil" ? "#true" : "#false"
}

function core_truep(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'true?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] == "#true" ? "#true" : "#false"
}

function core_falsep(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'false?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] == "#false" ? "#true" : "#false"
}

function core_stringp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'string?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^"/ ? "#true" : "#false"
}

function core_symbol(idx,    str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'symbol'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	str = types_heap[idx][1]
	if (str !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'symbol'. Expects string, supplied " types_typename(str) "."
	}
	return "'" substr(str, 2)
}

function core_symbolp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'symbol?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^'/ ? "#true" : "#false"
}

function core_keyword(idx,    str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'keyword'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	str = types_heap[idx][1]
	switch (str) {
	case /^:/:
		return str
	case /^"/:
		return "::" substr(str, 2)
	}
	return "!\"Incompatible type for argument 1 of builtin function 'keyword'. Expects string or keyword, supplied " types_typename(str) "."
}

function core_keywordp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'keyword?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^:/ ? "#true" : "#false"
}

function core_pr_str(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 1) " "
	}
	return "\"" substr(result, 1, length(result) - 1)
}

function core_str(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 0)
	}
	return "\"" result
}

function core_prn(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 1) " "
	}
	print substr(result, 1, length(result) - 1)
	return "#nil"
}

function core_println(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 0) " "
	}
	print substr(result, 1, length(result) - 1)
	return "#nil"
}

function core_read_string(idx,    str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'read-string'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	str = types_heap[idx][1]
	if (str !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'read-string'. Expects string, supplied " types_typename(str) "."
	}
	return reader_read_str(substr(str, 2))
}

function core_readline(idx,    prompt, var)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'readline'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	prompt = types_heap[idx][1]
	if (prompt !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'readline'. Expects string, supplied " types_typename(prompt) "."
	}
	printf("%s", printer_pr_str(prompt, 0))
	return getline var <= 0 ? "#nil" : "\"" var
}

function core_slurp(idx,    filename, str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'slurp'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	filename = types_heap[idx][1]
	if (filename !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'slurp'. Expects string, supplied " types_typename(filename) "."
	}
	str = readfile(substr(filename, 2))
	if (str == "" && ERRNO != "") {
		return "!\"cannot read file '" filename "', ERRNO = " ERRNO
	}
	return "\"" str
}

function core_lt(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '<'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '<'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '<'. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 < substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_le(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '<='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '<='. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '<='. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 <= substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_gt(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '>'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '>'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '>'. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 > substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_ge(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '>='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '>='. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '>='. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 >= substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_add(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" (substr(lhs, 2) + substr(rhs, 2))
}

function core_subtract(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" (substr(lhs, 2) - substr(rhs, 2))
}

function core_multiply(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" (substr(lhs, 2) * substr(rhs, 2))
}

function core_divide(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" int(substr(lhs, 2) / substr(rhs, 2))
}

function core_time_ms(idx)
{
	if (types_heap[idx]["len"] != 1) {
		return "!\"Invalid argument length for builtin function 'time-ms'. Expects no arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return "+" int(gettimeofday() * 1000)
}

function core_list(idx,    new_idx, len, i)
{
	new_idx = types_allocate()
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i])
	}
	types_heap[new_idx]["len"] = len - 1
	return "(" new_idx
}

function core_listp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'list?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\(/ ? "#true" : "#false"
}

function core_vector(idx,    new_idx, len, i)
{
	new_idx = types_allocate()
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i])
	}
	types_heap[new_idx]["len"] = len - 1
	return "[" new_idx
}

function core_vectorp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'vector?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\[/ ? "#true" : "#false"
}

function core_hash_map(idx,    len, new_idx, i, key)
{
	len = types_heap[idx]["len"]
	if (len % 2 != 1) {
		return "!\"Invalid argument length for builtin function 'hash-map'. Expects even number of arguments, supplied " (len - 1) "."
	}
	new_idx = types_allocate()
	for (i = 1; i < len; i += 2) {
		key = types_heap[idx][i]
		if (key !~ /^[":]/) {
			types_release("{" new_idx)
			return "!\"Incompatible type for key argument of builtin function 'hash-map'. Expects string or keyword, supplied " types_typename(key) "."
		}
		if (key in types_heap[new_idx]) {
			types_release(types_heap[new_idx][key])
		}
		types_addref(types_heap[new_idx][key] = types_heap[idx][i + 1])
	}
	return "{" new_idx
}

function core_mapp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'map?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\{/ ? "#true" : "#false"
}

function core_assoc(idx,    len, map, i, key, add_list, new_idx, map_idx)
{
	len = types_heap[idx]["len"]
	if (len % 2 != 0) {
		return "!\"Invalid argument length for builtin function 'assoc'. Expects odd number of arguments, supplied " (len - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'assoc'. Expects hash-map, supplied " types_typename(map) "."
	}
	for (i = 2; i < len; i += 2) {
		key = types_heap[idx][i]
		if (key !~ /^[":]/) {
			return "!\"Incompatible type for key argument of builtin function 'assoc'. Expects string or keyword, supplied " types_typename(key) "."
		}
		add_list[key] = types_heap[idx][i + 1]
	}
	new_idx = types_allocate()
	map_idx = substr(map, 2)
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]|^meta$/ && !(key in add_list)) {
			types_addref(types_heap[new_idx][key] = types_heap[map_idx][key])
		}
	}
	for (key in add_list) {
		types_addref(types_heap[new_idx][key] = add_list[key])
	}
	return "{" new_idx
}

function core_dissoc(idx,    len, map, i, key, del_list, new_idx, map_idx)
{
	len = types_heap[idx]["len"]
	if (len < 2) {
		return "!\"Invalid argument length for builtin function 'dissoc'. Expects at least 1 argument, supplied " (len - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'dissoc'. Expects hash-map, supplied " types_typename(map) "."
	}
	for (i = 2; i < len; ++i) {
		key = types_heap[idx][i]
		if (key !~ /^[":]/) {
			return "!\"Incompatible type for key argument of builtin function 'dissoc'. Expects string or keyword, supplied " types_typename(key) "."
		}
		del_list[key] = "1"
	}
	new_idx = types_allocate()
	map_idx = substr(map, 2)
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]|^meta$/ && !(key in del_list)) {
			types_addref(types_heap[new_idx][key] = types_heap[map_idx][key])
		}
	}
	return "{" new_idx
}

function core_get(idx,    map, key, map_idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'get'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/ && map != "#nil") {
		return "!\"Incompatible type for argument 1 of builtin function 'get'. Expects hash-map or nil, supplied " types_typename(map) "."
	}
	key = types_heap[idx][2]
	if (key !~ /^[":]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'get'. Expects string or keyword, supplied " types_typename(key) "."
	}
	if (map != "#nil" && key in types_heap[map_idx = substr(map, 2)]) {
		return types_addref(types_heap[map_idx][key])
	} else {
		return "#nil"
	}
}

function core_containsp(idx,    map, key)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'contains?'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'contains?'. Expects hash-map, supplied " types_typename(map) "."
	}
	key = types_heap[idx][2]
	if (key !~ /^[":]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'contains?'. Expects string or keyword, supplied " types_typename(key) "."
	}
	return key in types_heap[substr(map, 2)] ? "#true" : "#false"
}

function core_keys(idx,    map, map_idx, new_idx, len, key)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'keys'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'keys'. Expects hash-map, supplied " types_typename(map) "."
	}
	map_idx = substr(map, 2)
	new_idx = types_allocate()
	len = 0
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]/) {
			types_heap[new_idx][len++] = key
		}
	}
	types_heap[new_idx]["len"] = len
	return "(" new_idx
}

function core_vals(idx,    map, map_idx, new_idx, len, key)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'vals'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'vals'. Expects hash-map, supplied " types_typename(map) "."
	}
	map_idx = substr(map, 2)
	new_idx = types_allocate()
	len = 0
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]/) {
			types_addref(types_heap[new_idx][len++] = types_heap[map_idx][key])
		}
	}
	types_heap[new_idx]["len"] = len
	return "(" new_idx
}

function core_sequentialp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'sequential?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^[([]/ ? "#true" : "#false"
}

function core_cons(idx,    lst, lst_idx, new_idx, len, i)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'cons'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][2]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'cons'. Expects list or vector, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	new_idx = types_allocate()
	types_addref(types_heap[new_idx][0] = types_heap[idx][1])
	len = types_heap[lst_idx]["len"]
	for (i = 0; i < len; ++i) {
		types_addref(types_heap[new_idx][i + 1] = types_heap[lst_idx][i])
	}
	types_heap[new_idx]["len"] = len + 1
	return "(" new_idx
}

function core_concat(idx,    new_idx, new_len, len, i, lst, lst_idx, lst_len, j)
{
	new_idx = types_allocate()
	new_len = 0
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		lst = types_heap[idx][i]
		if (lst !~ /^[([]/) {
			types_heap[new_idx]["len"] = new_len
			types_release("(" new_idx)
			return "!\"Incompatible type for argument ' (i - 1) ' of builtin function 'concat'. Expects list or vector, supplied " types_typename(lst) "."
		}
		lst_idx = substr(lst, 2)
		lst_len = types_heap[lst_idx]["len"]
		for (j = 0; j < lst_len; ++j) {
			types_addref(types_heap[new_idx][new_len++] = types_heap[lst_idx][j])
		}
	}
	types_heap[new_idx]["len"] = new_len
	return "(" new_idx
}

function core_nth(idx,    lst, num, n, lst_idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'nth'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'nth'. Expects list or vector, supplied " types_typename(lst) "."
	}
	num = types_heap[idx][2]
	if (num !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function 'nth'. Expects number, supplied " types_typename(num) "."
	}
	n = substr(num, 2) + 0
	lst_idx = substr(lst, 2)
	if (n < 0 || types_heap[lst_idx]["len"] <= n) {
		return "!\"Index out of range. Sequence length is " types_heap[lst_idx]["len"] ", supplied " n "."
	}
	return types_addref(types_heap[lst_idx][n])
}

function core_first(idx,    lst, lst_idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'first'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst == "#nil") {
	        return "#nil"
	}
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'first'. Expects list, vector or nil, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	return types_heap[lst_idx]["len"] == 0 ? "#nil" : types_addref(types_heap[lst_idx][0])
}

function core_rest(idx,    lst, lst_idx, lst_len, new_idx, i)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'rest'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst == "#nil") {
	        new_idx = types_allocate()
	        types_heap[new_idx]["len"] = 0
	        return "(" new_idx
	}
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'rest'. Expects list, vector or nil, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	new_idx = types_allocate()
	for (i = 1; i < lst_len; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[lst_idx][i])
	}
	types_heap[new_idx]["len"] = lst_len - 1
	return "(" new_idx
}

function core_emptyp(idx,    lst)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'empty?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'empty?'. Expects list or vector, supplied " types_typename(lst) "."
	}
	return types_heap[substr(lst, 2)]["len"] == 0 ? "#true" : "#false"
}

function core_count(idx,    lst)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'count'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst ~ /^[([]/) {
		return "+" types_heap[substr(lst, 2)]["len"]
	}
	if (lst == "#nil") {
		return "+0"
	}
	return "!\"Incompatible type for argument 1 of builtin function 'count'. Expects list, vector or nil, supplied " types_typename(lst) "."
}

function core_apply(idx,    len, f, lst, new_idx, i, lst_idx, lst_len, f_idx, env, ret)
{
	len = types_heap[idx]["len"]
	if (len < 3) {
		return "!\"Invalid argument length for builtin function 'apply'. Expects at least 2 arguments, supplied " (len - 1) "."
	}
	f = types_heap[idx][1]
	if (f !~ /^[$&%]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'apply'. Expects function, supplied " types_typename(f) "."
	}
	lst = types_heap[idx][len - 1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument ' (len - 1) ' of builtin function 'apply'. Expects list or vector, supplied " types_typename(lst) "."
	}

	new_idx = types_allocate()
	types_addref(types_heap[new_idx][0] = f)
	for (i = 2; i < len - 1; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i])
	}
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	for (i = 0; i < lst_len; ++i) {
		types_addref(types_heap[new_idx][len + i - 2] = types_heap[lst_idx][i])
	}
	types_heap[new_idx]["len"] = len + lst_len - 2

	f_idx = substr(f, 2)
	switch (f) {
	case /^\$/:
		env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx)
		types_release("(" new_idx)
		if (env ~ /^!/) {
			return env
		}
		ret = EVAL(types_addref(types_heap[f_idx]["body"]), env)
		env_release(env)
		return ret
	case /^%/:
		f_idx = types_heap[f_idx]["func"]
	case /^&/:
		ret = @f_idx(new_idx)
		types_release("(" new_idx)
		return ret
	}
}

function core_map(idx,    f, lst, f_idx, lst_idx, lst_len, new_idx, expr_idx, i, env, ret, val)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'map'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	f = types_heap[idx][1]
	if (f !~ /^[$&%]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'map'. Expects function, supplied " types_typename(f) "."
	}
	lst = types_heap[idx][2]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'map'. Expects list or vector, supplied " types_typename(lst) "."
	}
	f_idx = substr(f, 2)
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	new_idx = types_allocate()
	types_heap[new_idx][0] = f
	types_heap[new_idx]["len"] = 2
	expr_idx = types_allocate()
	for (i = 0; i < lst_len; ++i) {
		types_heap[new_idx][1] = types_heap[lst_idx][i]
		switch (f) {
		case /^\$/:
			env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx)
			if (env ~ /^!/) {
				types_heap[expr_idx]["len"] = i
				types_heap[new_idx]["len"] = 0
				types_release("(" expr_idx)
				types_release("(" new_idx)
				return env
			}
			ret = EVAL(types_addref(types_heap[f_idx]["body"]), env)
			env_release(env)
			break
		case /^%/:
			f_idx = types_heap[f_idx]["func"]
		case /^&/:
			ret = @f_idx(new_idx)
			break
		}
		if (ret ~ /^!/) {
			types_heap[expr_idx]["len"] = i
			types_heap[new_idx]["len"] = 0
			types_release("(" expr_idx)
			types_release("(" new_idx)
			return ret
		}
		types_heap[expr_idx][i] = ret
	}
	types_heap[expr_idx]["len"] = lst_len
	types_heap[new_idx]["len"] = 0
	types_release("(" new_idx)
	return "(" expr_idx
}

function core_conj(idx,    len, lst, lst_idx, lst_len, new_idx, i, j)
{
	len = types_heap[idx]["len"]
	if (len < 3) {
		return "!\"Invalid argument length for builtin function 'conj'. Expects at least 2 arguments, supplied " (len - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'conj'. Expects list or vector, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	new_idx = types_allocate()
	j = 0
	if (lst ~ /^\(/) {
		for (i = len - 1; i >= 2; --i) {
			types_addref(types_heap[new_idx][j++] = types_heap[idx][i])
		}
		for (i = 0; i < lst_len; ++i) {
			types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i])
		}
	} else {
		for (i = 0; i < lst_len; ++i) {
			types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i])
		}
		for (i = 2; i < len; ++i) {
			types_addref(types_heap[new_idx][j++] = types_heap[idx][i])
		}
	}
	types_addref(types_heap[new_idx]["meta"] = types_heap[lst_idx]["meta"])
	types_heap[new_idx]["len"] = j
	return substr(lst, 1, 1) new_idx
}

function core_seq(idx,     obj, obj_idx, new_idx, i, len, chars)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'seq'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	obj = types_heap[idx][1]
	if (obj ~ /^[(]/) {
		if (types_heap[substr(obj, 2)]["len"] == 0) {
			return "#nil"
		}
		return types_addref(obj)
	} else if (obj ~ /^\[/) {
		obj_idx = substr(obj, 2)
		len = types_heap[obj_idx]["len"]
		if (len == 0) { return "#nil" }
		new_idx = types_allocate()
		for (i = 0; i < len; ++i) {
			types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i])
		}
		types_heap[new_idx]["len"] = len
		return "(" new_idx
	} else if (obj ~ /^"/) {
		obj_idx = substr(obj, 2)
		len = length(obj_idx)
		if (len == 0) { return "#nil" }
		new_idx = types_allocate()
		split(obj_idx, chars, "")
		for (i = 0; i <= len; ++i) {
			types_heap[new_idx][i] = "\"" chars[i+1]
		}
		types_heap[new_idx]["len"] = len
		return "(" new_idx
	} else if (obj == "#nil") {
		return "#nil"
	} else {
		return "!\"seq: called on non-sequence"
	}
}

function core_meta(idx,    obj, obj_idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'meta'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	obj = types_heap[idx][1]
	if (obj ~ /^[([{$%]/ && "meta" in types_heap[obj_idx = substr(obj, 2)]) {
		return types_addref(types_heap[obj_idx]["meta"])
	}
	return "#nil"
}

function core_with_meta(idx,    obj, obj_idx, new_idx, i, len)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'with-meta'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	obj = types_heap[idx][1]
	obj_idx = substr(obj, 2)
	new_idx = types_allocate()
	types_addref(types_heap[new_idx]["meta"] = types_heap[idx][2])
	switch (obj) {
	case /^[([]/:
		len = types_heap[obj_idx]["len"]
		for (i = 0; i < len; ++i) {
			types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i])
		}
		types_heap[new_idx]["len"] = len
		return substr(obj, 1, 1) new_idx
	case /^\{/:
		for (i in types_heap[obj_idx]) {
			if (i ~ /^[":]/) {
				types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i])
			}
		}
		return "{" new_idx
	case /^\$/:
		types_addref(types_heap[new_idx]["params"] = types_heap[obj_idx]["params"])
		types_addref(types_heap[new_idx]["body"] = types_heap[obj_idx]["body"])
		env_addref(types_heap[new_idx]["env"] = types_heap[obj_idx]["env"])
		return "$" new_idx
	case /^&/:
		types_heap[new_idx]["func"] = obj_idx
		return "%" new_idx
	case /^%/:
		types_heap[new_idx]["func"] = types_heap[obj_idx]["func"]
		return "%" new_idx
	default:
		types_release("{" new_idx)
		return "!\"Incompatible type for argument 1 of builtin function 'with-meta'. Expects list, vector, hash-map or function, supplied " types_typename(lst) "."
	}
}

function core_atom(idx,    atom_idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'atom'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	atom_idx = types_allocate()
	types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][1])
	return "?" atom_idx
}

function core_atomp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'atom?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\?/ ? "#true" : "#false"
}

function core_deref(idx,    atom)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'deref'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	atom = types_heap[idx][1]
	if (atom !~ /^\?/) {
		return "!\"Incompatible type for argument 1 of builtin function 'deref'. Expects atom, supplied " types_typename(atom) "."
	}
	return types_addref(types_heap[substr(atom, 2)]["obj"])
}

function core_reset(idx,    atom, atom_idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'reset!'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	atom = types_heap[idx][1]
	if (atom !~ /^\?/) {
		return "!\"Incompatible type for argument 1 of builtin function 'reset!'. Expects atom, supplied " types_typename(atom) "."
	}
	atom_idx = substr(atom, 2)
	types_release(types_heap[atom_idx]["obj"])
	return types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][2])
}

function core_swap(idx,    expr,    atom, f, lst_idx, ret, f_idx, env, i, len, atom_idx)
{
	len = types_heap[idx]["len"]
	if (len < 3) {
		return "!\"Invalid argument length for builtin function 'swap!'. Expects at least 2 arguments, supplied " (len - 1) "."
	}
	atom = types_heap[idx][1]
	if (atom !~ /^\?/) {
		return "!\"Incompatible type for argument 1 of builtin function 'swap!'. Expects atom, supplied " types_typename(atom) "."
	}
	f = types_heap[idx][2]
	if (f !~ /^[&$%]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'swap!'. Expects function, supplied " types_typename(f) "."
	}
	lst_idx = types_allocate()
	atom_idx = substr(atom, 2)
	types_addref(types_heap[lst_idx][0] = f)
	types_addref(types_heap[lst_idx][1] = types_heap[atom_idx]["obj"])
	for (i = 3; i < len; ++i) {
		types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
	}
	types_heap[lst_idx]["len"] = len - 1

	f_idx = substr(f, 2)
	switch (f) {
	case /^\$/:
		env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], lst_idx)
		types_release("(" lst_idx)
		if (env ~ /^!/) {
			return env
		}
		ret = EVAL(types_addref(types_heap[f_idx]["body"]), env)
		env_release(env)
		break
	case /^%/:
		f_idx = types_heap[f_idx]["func"]
	case /^&/:
		ret = @f_idx(lst_idx)
		types_release("(" lst_idx)
		break
	}

	if (ret ~ /^!/) {
		return ret
	}
	types_release(types_heap[atom_idx]["obj"])
	return types_addref(types_heap[atom_idx]["obj"] = ret)
}

function core_init()
{
	core_ns["'="] = "&core_eq"
	core_ns["'throw"] = "&core_throw"

	core_ns["'nil?"] = "&core_nilp"
	core_ns["'true?"] = "&core_truep"
	core_ns["'false?"] = "&core_falsep"
	core_ns["'string?"] = "&core_stringp"
	core_ns["'symbol"] = "&core_symbol"
	core_ns["'symbol?"] = "&core_symbolp"
	core_ns["'keyword"] = "&core_keyword"
	core_ns["'keyword?"] = "&core_keywordp"

	core_ns["'pr-str"] = "&core_pr_str"
	core_ns["'str"] = "&core_str"
	core_ns["'prn"] = "&core_prn"
	core_ns["'println"] = "&core_println"
	core_ns["'read-string"] = "&core_read_string"
	core_ns["'readline"] = "&core_readline"
	core_ns["'slurp"] = "&core_slurp"

	core_ns["'<"] = "&core_lt"
	core_ns["'<="] = "&core_le"
	core_ns["'>"] = "&core_gt"
	core_ns["'>="] = "&core_ge"
	core_ns["'+"] = "&core_add"
	core_ns["'-"] = "&core_subtract"
	core_ns["'*"] = "&core_multiply"
	core_ns["'/"] = "&core_divide"
	core_ns["'time-ms"] = "&core_time_ms"

	core_ns["'list"] = "&core_list"
	core_ns["'list?"] = "&core_listp"
	core_ns["'vector"] = "&core_vector"
	core_ns["'vector?"] = "&core_vectorp"
	core_ns["'hash-map"] = "&core_hash_map"
	core_ns["'map?"] = "&core_mapp"
	core_ns["'assoc"] = "&core_assoc"
	core_ns["'dissoc"] = "&core_dissoc"
	core_ns["'get"] = "&core_get"
	core_ns["'contains?"] = "&core_containsp"
	core_ns["'keys"] = "&core_keys"
	core_ns["'vals"] = "&core_vals"

	core_ns["'sequential?"] = "&core_sequentialp"
	core_ns["'cons"] = "&core_cons"
	core_ns["'concat"] = "&core_concat"
	core_ns["'nth"] = "&core_nth"
	core_ns["'first"] = "&core_first"
	core_ns["'rest"] = "&core_rest"
	core_ns["'empty?"] = "&core_emptyp"
	core_ns["'count"] = "&core_count"
	core_ns["'apply"] = "&core_apply"
	core_ns["'map"] = "&core_map"

	core_ns["'conj"] = "&core_conj"
	core_ns["'seq"] = "&core_seq"

	core_ns["'meta"] = "&core_meta"
	core_ns["'with-meta"] = "&core_with_meta"
	core_ns["'atom"] = "&core_atom"
	core_ns["'atom?"] = "&core_atomp"
	core_ns["'deref"] = "&core_deref"
	core_ns["'reset!"] = "&core_reset"
	core_ns["'swap!"] = "&core_swap"
}

BEGIN {
	core_init()
}

@load "readfile"
@load "time"

function core_eq_sub(lhs, rhs,    i, len)
{
	if (lhs ~ /^[([]/ && rhs ~ /^[([]/) {
		lhs = substr(lhs, 2)
		rhs = substr(rhs, 2)
		len = types_heap[lhs]["len"]
		if (len != types_heap[rhs]["len"]) {
			return 0
		}
		for (i = 0; i < len; ++i) {
			if (!core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) {
				return 0
			}
		}
		return 1
	} else if (lhs ~ /^\{/ && rhs ~ /^\{/) {
		lhs = substr(lhs, 2)
		rhs = substr(rhs, 2)
		if (length(types_heap[lhs]) != length(types_heap[rhs])) {
			return 0
		}
		for (i in types_heap[lhs]) {
			if (types_heap[lhs][i] ~ /^["':+#([{?&$%]/ &&
				!core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) {
				return 0
			}
		}
		return 1
	} else {
		return lhs == rhs
	}
}

function core_eq(idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return core_eq_sub(types_heap[idx][1], types_heap[idx][2]) ? "#true" : "#false"
}

function core_throw(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'throw'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return "!" types_addref(types_heap[idx][1])
}

function core_nilp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'nil?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] == "#nil" ? "#true" : "#false"
}

function core_truep(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'true?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] == "#true" ? "#true" : "#false"
}

function core_falsep(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'false?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] == "#false" ? "#true" : "#false"
}

function core_symbol(idx,    str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'symbol'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	str = types_heap[idx][1]
	if (str !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'symbol'. Expects string, supplied " types_typename(str) "."
	}
	return "'" substr(str, 2)
}

function core_symbolp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'symbol?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^'/ ? "#true" : "#false"
}

function core_keyword(idx,    str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'keyword'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	str = types_heap[idx][1]
	switch (str) {
	case /^:/:
		return str
	case /^"/:
		return "::" substr(str, 2)
	}
	return "!\"Incompatible type for argument 1 of builtin function 'keyword'. Expects string or keyword, supplied " types_typename(str) "."
}

function core_keywordp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'keyword?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^:/ ? "#true" : "#false"
}

function core_pr_str(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 1) " "
	}
	return "\"" substr(result, 1, length(result) - 1)
}

function core_str(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 0)
	}
	return "\"" result
}

function core_prn(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 1) " "
	}
	print substr(result, 1, length(result) - 1)
	return "#nil"
}

function core_println(idx,    i, len, result)
{
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		result = result printer_pr_str(types_heap[idx][i], 0) " "
	}
	print substr(result, 1, length(result) - 1)
	return "#nil"
}

function core_read_string(idx,    str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'read-string'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	str = types_heap[idx][1]
	if (str !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'read-string'. Expects string, supplied " types_typename(str) "."
	}
	return reader_read_str(substr(str, 2))
}

function core_readline(idx,    prompt, var)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'readline'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	prompt = types_heap[idx][1]
	if (prompt !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'readline'. Expects string, supplied " types_typename(prompt) "."
	}
	printf("%s", printer_pr_str(prompt, 0))
	return getline var <= 0 ? "#nil" : "\"" var
}

function core_slurp(idx,    filename, str)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'slurp'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	filename = types_heap[idx][1]
	if (filename !~ /^"/) {
		return "!\"Incompatible type for argument 1 of builtin function 'slurp'. Expects string, supplied " types_typename(filename) "."
	}
	str = readfile(substr(filename, 2))
	if (str == "" && ERRNO != "") {
		return "!\"cannot read file '" filename "', ERRNO = " ERRNO
	}
	return "\"" str
}

function core_lt(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '<'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '<'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '<'. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 < substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_le(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '<='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '<='. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '<='. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 <= substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_gt(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '>'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '>'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '>'. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 > substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_ge(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '>='. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '>='. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '>='. Expects number, supplied " types_typename(rhs) "."
	}
	return substr(lhs, 2) + 0 >= substr(rhs, 2) + 0 ? "#true" : "#false"
}

function core_add(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" (substr(lhs, 2) + substr(rhs, 2))
}

function core_subtract(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" (substr(lhs, 2) - substr(rhs, 2))
}

function core_multiply(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" (substr(lhs, 2) * substr(rhs, 2))
}

function core_divide(idx,    lhs, rhs)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lhs = types_heap[idx][1]
	if (lhs !~ /^\+/) {
		return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "."
	}
	rhs = types_heap[idx][2]
	if (rhs !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "."
	}
	return "+" int(substr(lhs, 2) / substr(rhs, 2))
}

function core_time_ms(idx)
{
	if (types_heap[idx]["len"] != 1) {
		return "!\"Invalid argument length for builtin function 'time-ms'. Expects no arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return "+" int(gettimeofday() * 1000)
}

function core_list(idx,    new_idx, len, i)
{
	new_idx = types_allocate()
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i])
	}
	types_heap[new_idx]["len"] = len - 1
	return "(" new_idx
}

function core_listp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'list?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\(/ ? "#true" : "#false"
}

function core_vector(idx,    new_idx, len, i)
{
	new_idx = types_allocate()
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i])
	}
	types_heap[new_idx]["len"] = len - 1
	return "[" new_idx
}

function core_vectorp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'vector?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\[/ ? "#true" : "#false"
}

function core_hash_map(idx,    len, new_idx, i, key)
{
	len = types_heap[idx]["len"]
	if (len % 2 != 1) {
		return "!\"Invalid argument length for builtin function 'hash-map'. Expects even number of arguments, supplied " (len - 1) "."
	}
	new_idx = types_allocate()
	for (i = 1; i < len; i += 2) {
		key = types_heap[idx][i]
		if (key !~ /^[":]/) {
			types_release("{" new_idx)
			return "!\"Incompatible type for key argument of builtin function 'hash-map'. Expects string or keyword, supplied " types_typename(key) "."
		}
		if (key in types_heap[new_idx]) {
			types_release(types_heap[new_idx][key])
		}
		types_addref(types_heap[new_idx][key] = types_heap[idx][i + 1])
	}
	return "{" new_idx
}

function core_mapp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'map?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\{/ ? "#true" : "#false"
}

function core_assoc(idx,    len, map, i, key, add_list, new_idx, map_idx)
{
	len = types_heap[idx]["len"]
	if (len % 2 != 0) {
		return "!\"Invalid argument length for builtin function 'assoc'. Expects odd number of arguments, supplied " (len - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'assoc'. Expects hash-map, supplied " types_typename(map) "."
	}
	for (i = 2; i < len; i += 2) {
		key = types_heap[idx][i]
		if (key !~ /^[":]/) {
			return "!\"Incompatible type for key argument of builtin function 'assoc'. Expects string or keyword, supplied " types_typename(key) "."
		}
		add_list[key] = types_heap[idx][i + 1]
	}
	new_idx = types_allocate()
	map_idx = substr(map, 2)
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]|^meta$/ && !(key in add_list)) {
			types_addref(types_heap[new_idx][key] = types_heap[map_idx][key])
		}
	}
	for (key in add_list) {
		types_addref(types_heap[new_idx][key] = add_list[key])
	}
	return "{" new_idx
}

function core_dissoc(idx,    len, map, i, key, del_list, new_idx, map_idx)
{
	len = types_heap[idx]["len"]
	if (len < 2) {
		return "!\"Invalid argument length for builtin function 'dissoc'. Expects at least 1 argument, supplied " (len - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'dissoc'. Expects hash-map, supplied " types_typename(map) "."
	}
	for (i = 2; i < len; ++i) {
		key = types_heap[idx][i]
		if (key !~ /^[":]/) {
			return "!\"Incompatible type for key argument of builtin function 'dissoc'. Expects string or keyword, supplied " types_typename(key) "."
		}
		del_list[key] = "1"
	}
	new_idx = types_allocate()
	map_idx = substr(map, 2)
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]|^meta$/ && !(key in del_list)) {
			types_addref(types_heap[new_idx][key] = types_heap[map_idx][key])
		}
	}
	return "{" new_idx
}

function core_get(idx,    map, key, map_idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'get'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/ && map != "#nil") {
		return "!\"Incompatible type for argument 1 of builtin function 'get'. Expects hash-map or nil, supplied " types_typename(map) "."
	}
	key = types_heap[idx][2]
	if (key !~ /^[":]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'get'. Expects string or keyword, supplied " types_typename(key) "."
	}
	if (map != "#nil" && key in types_heap[map_idx = substr(map, 2)]) {
		return types_addref(types_heap[map_idx][key])
	} else {
		return "#nil"
	}
}

function core_containsp(idx,    map, key)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'contains?'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'contains?'. Expects hash-map, supplied " types_typename(map) "."
	}
	key = types_heap[idx][2]
	if (key !~ /^[":]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'contains?'. Expects string or keyword, supplied " types_typename(key) "."
	}
	return key in types_heap[substr(map, 2)] ? "#true" : "#false"
}

function core_keys(idx,    map, map_idx, new_idx, len, key)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'keys'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'keys'. Expects hash-map, supplied " types_typename(map) "."
	}
	map_idx = substr(map, 2)
	new_idx = types_allocate()
	len = 0
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]/) {
			types_heap[new_idx][len++] = key
		}
	}
	types_heap[new_idx]["len"] = len
	return "(" new_idx
}

function core_vals(idx,    map, map_idx, new_idx, len, key)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'vals'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	map = types_heap[idx][1]
	if (map !~ /^\{/) {
		return "!\"Incompatible type for argument 1 of builtin function 'vals'. Expects hash-map, supplied " types_typename(map) "."
	}
	map_idx = substr(map, 2)
	new_idx = types_allocate()
	len = 0
	for (key in types_heap[map_idx]) {
		if (key ~ /^[":]/) {
			types_addref(types_heap[new_idx][len++] = types_heap[map_idx][key])
		}
	}
	types_heap[new_idx]["len"] = len
	return "(" new_idx
}

function core_sequentialp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'sequential?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^[([]/ ? "#true" : "#false"
}

function core_cons(idx,    lst, lst_idx, new_idx, len, i)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'cons'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][2]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'cons'. Expects list or vector, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	new_idx = types_allocate()
	types_addref(types_heap[new_idx][0] = types_heap[idx][1])
	len = types_heap[lst_idx]["len"]
	for (i = 0; i < len; ++i) {
		types_addref(types_heap[new_idx][i + 1] = types_heap[lst_idx][i])
	}
	types_heap[new_idx]["len"] = len + 1
	return "(" new_idx
}

function core_concat(idx,    new_idx, new_len, len, i, lst, lst_idx, lst_len, j)
{
	new_idx = types_allocate()
	new_len = 0
	len = types_heap[idx]["len"]
	for (i = 1; i < len; ++i) {
		lst = types_heap[idx][i]
		if (lst !~ /^[([]/) {
			types_heap[new_idx]["len"] = new_len
			types_release("(" new_idx)
			return "!\"Incompatible type for argument ' (i - 1) ' of builtin function 'concat'. Expects list or vector, supplied " types_typename(lst) "."
		}
		lst_idx = substr(lst, 2)
		lst_len = types_heap[lst_idx]["len"]
		for (j = 0; j < lst_len; ++j) {
			types_addref(types_heap[new_idx][new_len++] = types_heap[lst_idx][j])
		}
	}
	types_heap[new_idx]["len"] = new_len
	return "(" new_idx
}

function core_nth(idx,    lst, num, n, lst_idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'nth'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'nth'. Expects list or vector, supplied " types_typename(lst) "."
	}
	num = types_heap[idx][2]
	if (num !~ /^\+/) {
		return "!\"Incompatible type for argument 2 of builtin function 'nth'. Expects number, supplied " types_typename(num) "."
	}
	n = substr(num, 2) + 0
	lst_idx = substr(lst, 2)
	if (n < 0 || types_heap[lst_idx]["len"] <= n) {
		return "!\"Index out of range. Sequence length is " types_heap[lst_idx]["len"] ", supplied " n "."
	}
	return types_addref(types_heap[lst_idx][n])
}

function core_first(idx,    lst, lst_idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'first'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst == "#nil") {
	        return "#nil"
	}
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'first'. Expects list, vector or nil, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	return types_heap[lst_idx]["len"] == 0 ? "#nil" : types_addref(types_heap[lst_idx][0])
}

function core_rest(idx,    lst, lst_idx, lst_len, new_idx, i)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'rest'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst == "#nil") {
	        new_idx = types_allocate()
	        types_heap[new_idx]["len"] = 0
	        return "(" new_idx
	}
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'rest'. Expects list, vector or nil, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	new_idx = types_allocate()
	for (i = 1; i < lst_len; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[lst_idx][i])
	}
	types_heap[new_idx]["len"] = lst_len - 1
	return "(" new_idx
}

function core_emptyp(idx,    lst)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'empty?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'empty?'. Expects list or vector, supplied " types_typename(lst) "."
	}
	return types_heap[substr(lst, 2)]["len"] == 0 ? "#true" : "#false"
}

function core_count(idx,    lst)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'count'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst ~ /^[([]/) {
		return "+" types_heap[substr(lst, 2)]["len"]
	}
	if (lst == "#nil") {
		return "+0"
	}
	return "!\"Incompatible type for argument 1 of builtin function 'count'. Expects list, vector or nil, supplied " types_typename(lst) "."
}

function core_apply(idx,    len, f, lst, new_idx, i, lst_idx, lst_len, f_idx, env, ret)
{
	len = types_heap[idx]["len"]
	if (len < 3) {
		return "!\"Invalid argument length for builtin function 'apply'. Expects at least 2 arguments, supplied " (len - 1) "."
	}
	f = types_heap[idx][1]
	if (f !~ /^[$&%]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'apply'. Expects function, supplied " types_typename(f) "."
	}
	lst = types_heap[idx][len - 1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument ' (len - 1) ' of builtin function 'apply'. Expects list or vector, supplied " types_typename(lst) "."
	}

	new_idx = types_allocate()
	types_addref(types_heap[new_idx][0] = f)
	for (i = 2; i < len - 1; ++i) {
		types_addref(types_heap[new_idx][i - 1] = types_heap[idx][i])
	}
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	for (i = 0; i < lst_len; ++i) {
		types_addref(types_heap[new_idx][len + i - 2] = types_heap[lst_idx][i])
	}
	types_heap[new_idx]["len"] = len + lst_len - 2

	f_idx = substr(f, 2)
	switch (f) {
	case /^\$/:
		env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx)
		types_release("(" new_idx)
		if (env ~ /^!/) {
			return env
		}
		ret = EVAL(types_addref(types_heap[f_idx]["body"]), env)
		env_release(env)
		return ret
	case /^%/:
		f_idx = types_heap[f_idx]["func"]
	case /^&/:
		ret = @f_idx(new_idx)
		types_release("(" new_idx)
		return ret
	}
}

function core_map(idx,    f, lst, f_idx, lst_idx, lst_len, new_idx, expr_idx, i, env, ret, val)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'map'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	f = types_heap[idx][1]
	if (f !~ /^[$&%]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'map'. Expects function, supplied " types_typename(f) "."
	}
	lst = types_heap[idx][2]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'map'. Expects list or vector, supplied " types_typename(lst) "."
	}
	f_idx = substr(f, 2)
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	new_idx = types_allocate()
	types_heap[new_idx][0] = f
	types_heap[new_idx]["len"] = 2
	expr_idx = types_allocate()
	for (i = 0; i < lst_len; ++i) {
		types_heap[new_idx][1] = types_heap[lst_idx][i]
		switch (f) {
		case /^\$/:
			env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], new_idx)
			if (env ~ /^!/) {
				types_heap[expr_idx]["len"] = i
				types_heap[new_idx]["len"] = 0
				types_release("(" expr_idx)
				types_release("(" new_idx)
				return env
			}
			ret = EVAL(types_addref(types_heap[f_idx]["body"]), env)
			env_release(env)
			break
		case /^%/:
			f_idx = types_heap[f_idx]["func"]
		case /^&/:
			ret = @f_idx(new_idx)
			break
		}
		if (ret ~ /^!/) {
			types_heap[expr_idx]["len"] = i
			types_heap[new_idx]["len"] = 0
			types_release("(" expr_idx)
			types_release("(" new_idx)
			return ret
		}
		types_heap[expr_idx][i] = ret
	}
	types_heap[expr_idx]["len"] = lst_len
	types_heap[new_idx]["len"] = 0
	types_release("(" new_idx)
	return "(" expr_idx
}

function core_conj(idx,    len, lst, lst_idx, lst_len, new_idx, i, j)
{
	len = types_heap[idx]["len"]
	if (len < 3) {
		return "!\"Invalid argument length for builtin function 'conj'. Expects at least 2 arguments, supplied " (len - 1) "."
	}
	lst = types_heap[idx][1]
	if (lst !~ /^[([]/) {
		return "!\"Incompatible type for argument 1 of builtin function 'conj'. Expects list or vector, supplied " types_typename(lst) "."
	}
	lst_idx = substr(lst, 2)
	lst_len = types_heap[lst_idx]["len"]
	new_idx = types_allocate()
	j = 0
	if (lst ~ /^\(/) {
		for (i = len - 1; i >= 2; --i) {
			types_addref(types_heap[new_idx][j++] = types_heap[idx][i])
		}
		for (i = 0; i < lst_len; ++i) {
			types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i])
		}
	} else {
		for (i = 0; i < lst_len; ++i) {
			types_addref(types_heap[new_idx][j++] = types_heap[lst_idx][i])
		}
		for (i = 2; i < len; ++i) {
			types_addref(types_heap[new_idx][j++] = types_heap[idx][i])
		}
	}
	types_addref(types_heap[new_idx]["meta"] = types_heap[lst_idx]["meta"])
	types_heap[new_idx]["len"] = j
	return substr(lst, 1, 1) new_idx
}

function core_meta(idx,    obj, obj_idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'meta'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	obj = types_heap[idx][1]
	if (obj ~ /^[([{$%]/ && "meta" in types_heap[obj_idx = substr(obj, 2)]) {
		return types_addref(types_heap[obj_idx]["meta"])
	}
	return "#nil"
}

function core_with_meta(idx,    obj, obj_idx, new_idx, i, len)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'with-meta'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	obj = types_heap[idx][1]
	obj_idx = substr(obj, 2)
	new_idx = types_allocate()
	types_addref(types_heap[new_idx]["meta"] = types_heap[idx][2])
	switch (obj) {
	case /^[([]/:
		len = types_heap[obj_idx]["len"]
		for (i = 0; i < len; ++i) {
			types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i])
		}
		types_heap[new_idx]["len"] = len
		return substr(obj, 1, 1) new_idx
	case /^\{/:
		for (i in types_heap[obj_idx]) {
			if (i ~ /^[":]/) {
				types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i])
			}
		}
		return "{" new_idx
	case /^\$/:
		types_addref(types_heap[new_idx]["params"] = types_heap[obj_idx]["params"])
		types_addref(types_heap[new_idx]["body"] = types_heap[obj_idx]["body"])
		env_addref(types_heap[new_idx]["env"] = types_heap[obj_idx]["env"])
		return "$" new_idx
	case /^&/:
		types_heap[new_idx]["func"] = obj_idx
		return "%" new_idx
	case /^%/:
		types_heap[new_idx]["func"] = types_heap[obj_idx]["func"]
		return "%" new_idx
	default:
		types_release("{" new_idx)
		return "!\"Incompatible type for argument 1 of builtin function 'with-meta'. Expects list, vector, hash-map or function, supplied " types_typename(lst) "."
	}
}

function core_atom(idx,    atom_idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'atom'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	atom_idx = types_allocate()
	types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][1])
	return "?" atom_idx
}

function core_atomp(idx)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'atom?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	return types_heap[idx][1] ~ /^\?/ ? "#true" : "#false"
}

function core_deref(idx,    atom)
{
	if (types_heap[idx]["len"] != 2) {
		return "!\"Invalid argument length for builtin function 'deref'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
	}
	atom = types_heap[idx][1]
	if (atom !~ /^\?/) {
		return "!\"Incompatible type for argument 1 of builtin function 'deref'. Expects atom, supplied " types_typename(atom) "."
	}
	return types_addref(types_heap[substr(atom, 2)]["obj"])
}

function core_reset(idx,    atom, atom_idx)
{
	if (types_heap[idx]["len"] != 3) {
		return "!\"Invalid argument length for builtin function 'reset!'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "."
	}
	atom = types_heap[idx][1]
	if (atom !~ /^\?/) {
		return "!\"Incompatible type for argument 1 of builtin function 'reset!'. Expects atom, supplied " types_typename(atom) "."
	}
	atom_idx = substr(atom, 2)
	types_release(types_heap[atom_idx]["obj"])
	return types_addref(types_heap[atom_idx]["obj"] = types_heap[idx][2])
}

function core_swap(idx,    expr,    atom, f, lst_idx, ret, f_idx, env, i, len, atom_idx)
{
	len = types_heap[idx]["len"]
	if (len < 3) {
		return "!\"Invalid argument length for builtin function 'swap!'. Expects at least 2 arguments, supplied " (len - 1) "."
	}
	atom = types_heap[idx][1]
	if (atom !~ /^\?/) {
		return "!\"Incompatible type for argument 1 of builtin function 'swap!'. Expects atom, supplied " types_typename(atom) "."
	}
	f = types_heap[idx][2]
	if (f !~ /^[&$%]/) {
		return "!\"Incompatible type for argument 2 of builtin function 'swap!'. Expects function, supplied " types_typename(f) "."
	}
	lst_idx = types_allocate()
	atom_idx = substr(atom, 2)
	types_addref(types_heap[lst_idx][0] = f)
	types_addref(types_heap[lst_idx][1] = types_heap[atom_idx]["obj"])
	for (i = 3; i < len; ++i) {
		types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
	}
	types_heap[lst_idx]["len"] = len - 1

	f_idx = substr(f, 2)
	switch (f) {
	case /^\$/:
		env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], lst_idx)
		types_release("(" lst_idx)
		if (env ~ /^!/) {
			return env
		}
		ret = EVAL(types_addref(types_heap[f_idx]["body"]), env)
		env_release(env)
		break
	case /^%/:
		f_idx = types_heap[f_idx]["func"]
	case /^&/:
		ret = @f_idx(lst_idx)
		types_release("(" lst_idx)
		break
	}

	if (ret ~ /^!/) {
		return ret
	}
	types_release(types_heap[atom_idx]["obj"])
	return types_addref(types_heap[atom_idx]["obj"] = ret)
}

function core_init()
{
	core_ns["'="] = "&core_eq"
	core_ns["'throw"] = "&core_throw"

	core_ns["'nil?"] = "&core_nilp"
	core_ns["'true?"] = "&core_truep"
	core_ns["'false?"] = "&core_falsep"
	core_ns["'symbol"] = "&core_symbol"
	core_ns["'symbol?"] = "&core_symbolp"
	core_ns["'keyword"] = "&core_keyword"
	core_ns["'keyword?"] = "&core_keywordp"

	core_ns["'pr-str"] = "&core_pr_str"
	core_ns["'str"] = "&core_str"
	core_ns["'prn"] = "&core_prn"
	core_ns["'println"] = "&core_println"
	core_ns["'read-string"] = "&core_read_string"
	core_ns["'readline"] = "&core_readline"
	core_ns["'slurp"] = "&core_slurp"

	core_ns["'<"] = "&core_lt"
	core_ns["'<="] = "&core_le"
	core_ns["'>"] = "&core_gt"
	core_ns["'>="] = "&core_ge"
	core_ns["'+"] = "&core_add"
	core_ns["'-"] = "&core_subtract"
	core_ns["'*"] = "&core_multiply"
	core_ns["'/"] = "&core_divide"
	core_ns["'time-ms"] = "&core_time_ms"

	core_ns["'list"] = "&core_list"
	core_ns["'list?"] = "&core_listp"
	core_ns["'vector"] = "&core_vector"
	core_ns["'vector?"] = "&core_vectorp"
	core_ns["'hash-map"] = "&core_hash_map"
	core_ns["'map?"] = "&core_mapp"
	core_ns["'assoc"] = "&core_assoc"
	core_ns["'dissoc"] = "&core_dissoc"
	core_ns["'get"] = "&core_get"
	core_ns["'contains?"] = "&core_containsp"
	core_ns["'keys"] = "&core_keys"
	core_ns["'vals"] = "&core_vals"

	core_ns["'sequential?"] = "&core_sequentialp"
	core_ns["'cons"] = "&core_cons"
	core_ns["'concat"] = "&core_concat"
	core_ns["'nth"] = "&core_nth"
	core_ns["'first"] = "&core_first"
	core_ns["'rest"] = "&core_rest"
	core_ns["'empty?"] = "&core_emptyp"
	core_ns["'count"] = "&core_count"
	core_ns["'apply"] = "&core_apply"
	core_ns["'map"] = "&core_map"

	core_ns["'conj"] = "&core_conj"

	core_ns["'meta"] = "&core_meta"
	core_ns["'with-meta"] = "&core_with_meta"
	core_ns["'atom"] = "&core_atom"
	core_ns["'atom?"] = "&core_atomp"
	core_ns["'deref"] = "&core_deref"
	core_ns["'reset!"] = "&core_reset"
	core_ns["'swap!"] = "&core_swap"
}

BEGIN {
	core_init()
}


Malformed (Sm 1 Ep 1) should be (Sn 1 Ep 1)

# Produce a raw data spreadsheet from URLs found in https://watch.mhzchoice.com/sitemap.xml

# INVOCATION
#    awk -v ERRORS=$ERRORS -v RAW_TITLES=$RAW_TITLES -f getMHzFromSitemap.awk >>$UNSORTED

# Field numbers
# 1 Title  2 Seasons  3 Episodes  4 Duration  5 Genre  6 Country  7 Language  8 Rating  9 Description

### Begin season processing

# Determine whether this is a page 2
#    <meta name="apple-itunes-app" content="app-id=1096194231, \
#        app-argument=https://mhzchoice.vhx.tv/detective-montalbano?page=2">
/<meta name="apple-itunes-app" content=".*?page=2">/ {
    page2 = "yes"
    next
}

# Season Title & Season URL
#    <form class="form"><input value="https://watch.mhzchoice.com/gasmamman/season:1" type="text" \
#        class="text text-center border-none site-background-color site-font-secondary-color" /></form>
# This returns incorrect values if page2 == "yes", but those values are never used
/<form class="form">/ {
    split ($0,fld,"\"")
    seasonURL = fld[4]
    shortSeasonURL = seasonURL
    sub (/.*watch/,"watch",shortSeasonURL)
    split (seasonURL,fld,":")
    seasonNumber = fld[3]
    seasonTitle = "Season " seasonNumber
    # print "==> seasonURL = " seasonURL > "/dev/stderr"
    # print "==> seasonNumber = " seasonNumber > "/dev/stderr"
    # print "==> seasonTitle = " seasonTitle > "/dev/stderr"
    next
}

# Season episodes
#

#      9 Episodes
#

# Extract only the number of episodes, # but if this is page 2 skip to avoid double counting
/<h2 class=.*content-label/,/<\/h2>/ {
    sub (/^ */,"")
    if ($0 ~ / Episode/) {
        seasonEpisodes = $1
        next
    }
}

### Begin show processing

# Show Title
#    <title>Gasmamman - MHz Choice</title>
/<title>/ {
    split ($0,fld,"[<>]")
    showTitle = fld[3]
    sub (" - MHz Choice","",showTitle)
    gsub (/'/,"'",showTitle)
    if (match (showTitle, /^The /)) {
        showTitle = substr(showTitle, 5) ", The"
    }
    print showTitle >> RAW_TITLES
    # print "==> showTitle = " showTitle > "/dev/stderr"
    next
}

# Show Descriptor
#    <meta name="description" content="DRAMA - CRIME | SWEDEN | SWEDISH WITH ENGLISH SUBTITLES | TV-14
#    Alexandra Rapaport stars as a suburban mom pulled into the criminal \
#        underworld to pay off her murdered husband’s debts.">
#
# There should be four header fields prior to the description
/<meta name="description" content="/,/">/ {
     # if we're on the first line of this block ...
    if ($0 ~ /name="description" content="/) {
        headerAdded = "no"
        sub (/.*name="description" content="/,"")
        # Special processing for "Arde Madrid: Burn Madrid Burn" which is missing a rating
        if ($0 ~ /COMEDY \| SPAIN \| SPANISH WITH ENGLISH SUBTITLES \| $/ && showTitle ~ /Arde Madrid:/) {
            printf ("==> Added TV-MA Rating to \"%s\"\n", showTitle) >> ERRORS
            $0 = "COMEDY \| SPAIN \| SPANISH WITH ENGLISH SUBTITLES \| TV-MA"
        }
    }
    # If we find a header, clean it up and put it before the description
    if ($0 ~ /\| {1,2}TV-/) {
        sub (/WITH ENGLISH SUBTITLES /,"")
        sub (/SCANDINAVIAN CRIME FICTION/,"Sweden")
        sub (/NONFICTION - DOCUMENTARY/,"Documentary")
        sub (/NON-FICTION - DOCUMENTARY/,"Documentary")
        gsub (/ \| {1,2}/,"|")
        sub (/\r/,"")
        # Split out header fields
        numFields = split ($0,fld,"\|")
        # lowercase everything but the first character in all fields but the last
        for (i = 1; i < numFields; ++i) {
            fld[i] = substr(fld[i],1,1) tolower(substr(fld[i],2))
            # uppercase the first character of any second word
            if (match (fld[i],/ /)) {
                fld[i] = substr(fld[i],1,RSTART) toupper(substr(fld[i],RSTART+1,1)) (substr(fld[i],RSTART+2))
            }
        }
        # Put the finalized header before the description
        if (numFields > 3 ) {
            sub ("Drama-crime","Drama - crime",fld[1])
            gsub (" ","",fld[4])
            showDescriptor =  fld[1] "\t" fld[2] "\t" fld[(numFields-1)] "\t" fld[(numFields)] "\t"
            headerAdded = "yes"
        }
    } else {
        # if we didn't find a header in this block, add a blank one
        if (headerAdded == "no") {
            printf ("==> Added blank header for \"%s\"\n", showTitle) >> ERRORS
            showDescriptor = "\t\t\t\t"
        }
        # We found a description, clean it up and add it
        gsub (/  */," ")
        gsub (/'/,"'")
        gsub (/"/,"\"")
        gsub (/&/,"\\&")
        gsub (/‘/,"’")
        gsub (/’/,"’")
        gsub (/“/,"“")
        gsub (/”/,"”")
        gsub (/\r/," ")
        # if it's not the last line of the description, add it
        if ($0 !~ /"\>/) {
            printf ("==> Multi line description in \"%s\"\n", showTitle) >> ERRORS
            showDescriptor = showDescriptor $0
        } else {
            # if it's the last line of the description, add it
            sub (/"\>/,"")
            showDescriptor = showDescriptor $0
        }
    }
    # print "==> showDescriptor = " showDescriptor > "/dev/stderr"
    next
}

# Show URL
#    <meta property="og:url" content="https://watch.mhzchoice.com/gasmamman">
/<meta property="og:url" content=/ {
    split ($0,fld,"\"")
    showURL = fld[4]
    # print "==> showURL = " showURL > "/dev/stderr"
    next
}

# Show seasons
#

#        3 Seasons
#

# Extract only the number of seasons, # but if this is page 2 skip to avoid double counting
/<h2 class=.*collection-stats"/,/<\/h2>/ {
    sub (/^ */,"")
    # Only if there are two or more seasons, a show with only one season doesn't have this
    if ($0 ~ / Season/) {
        showSeasons = $1
        next
    }
}

### Begin episode processing

# Episode URL(s)
#

#
/
/,/<a href="https:/ {
    if ($0 ~ / episodeURL = " episodeURL > "/dev/stderr"
        next
    }
}

# Episode Duration(s)
#
44:15

# Extract the duration
/<div class="duration-container/ {
    split ($0,fld,"[<>]")
    episodeDuration = fld[3]
    gsub (/ /,"",episodeDuration)
    # Spreadsheets decipher 2 part durations as time-of-day so make sure they're 3 parts
    if (split (episodeDuration, tm, ":") == 2)
        episodeDuration = "00:" episodeDuration
    # print "==> episodeDuration = " episodeDuration > "/dev/stderr"
    next
}

# Episode Title(s)
#
 \
#        Gåsmamman: Episode 01 (Sn 1 Ep 1)

/<h3 class="tooltip-item-title/{
    split ($0,fld,"[<>]")
    episodeTitle = fld[5]
    gsub (/'/,"'",episodeTitle)
    gsub (/"/,"\"\"",episodeTitle)
    gsub (/&/,"\\&",episodeTitle)
    # If start of episodeTitle == showTitle ": ", remove the redundant part.
    if ((match (episodeTitle, showTitle ": ")) == 1) {
        episodeTitle = substr(episodeTitle, RLENGTH + 1)
    }
    # print "==> episodeTitle = " episodeTitle > "/dev/stderr"
    #
    # If there is a trailing (Sn 1 Ep 1), remove it
    # Handle normal (Sn 1 Ep 1) with variations in spacing and capitalization
    # and ones missing the second letter (Sn 1 E 1), (S1 E1), or wrong second letter (Sm 1 Ep 1)
    if (match (episodeTitle,\
        /[ ]*\(S[Nnm]*[ ]*[[:digit:]]{1,2}[ ]+[Ee][Pp]*[ ]*[[:digit:]]{1,3}[[:space:]]*\)/))  {
            if (episodeTitle ~ /\(Sm /)
                printf ("==> Malformed Sn in \"%s: %s\"\n", showTitle, episodeTitle) >> ERRORS
            sub (/[ ]*\(S[Nnm]*[ ]*[[:digit:]]{1,2}[ ]+[Ee][Pp]*[ ]*[[:digit:]]{1,3}[[:space:]]*\)/,\
                "",episodeTitle)
            # print "==> episodeTitle = " episodeTitle > "/dev/stderr"
    }
    #
    # Default episodeType to "E"
    episodeType = "E"
    # If episode is a BONUS:, set episodeType to "X"
    if (episodeTitle ~ /BONUS|Montalbano and Me/)
        episodeType = "X"
    # If episode is a Trailer (i.e. First look), set episodeType to "T"
    if (episodeTitle ~ /^PR \|/) {
        episodeType = "T"
        seasonEpisodes = seasonEpisodes - 1
    }
    # print "==> episodeType = " episodeType > "/dev/stderr"
    next
}

# Episode Number(s)
#

#         Episode 1
#

/
<span class='media-identifier/,/<\/div>/ {
    sub (/^ */,"")
    if ($0 ~ /Episode /) {
        episodeNumber = $2
        if (showTitle == "Detective Montalbano" && page2 == "yes") {
            oldEpisodeNumber = episodeNumber
            episodeNumber += 24
            printf ("==> Changed E%02d to %s%02d: %s\n", oldEpisodeNumber, episodeType, \
                    episodeNumber, shortEpisodeURL) >> ERRORS
        }
        # print "==> episodeNumber = " episodeNumber > "/dev/stderr"
        next
    }

### Wrap-up episode processing when Episode Description is found
### print only on LONG_SPREADSHEET
    # print $0 > "/dev/stderr"

    # Episode Description(s)
    #

    #
Preparing for her sister's wedding, Sonja's idyllic life is shattered by tragedy.
    #

    if ($0 ~ /
/) {
        split ($0,fld,"[<>]")
        paragraph = fld[3]
        gsub (/&/,"\\&",paragraph)
        # Could be in multiple paragraphs
        descriptionLinesFound += 1
        if (paragraph != "")
            episodeDescription = episodeDescription (descriptionLinesFound == 1 ? "" : " ") paragraph
        gsub (/&/,"\\&",episodeDescription)
        # print "descriptionLinesFound = " descriptionLinesFound > "/dev/stderr"
        # print "==> episodeDescription from
 = \n" episodeDescription > "/dev/stderr"
        next
    }
    #  =HYPERLINK("https://watch.mhzchoice.com/gasmamman/season:1/videos/gasmamman-episode-01-sn-1-ep-1-1";\
    #  "Gasmamman, S01E01, Gåsmamman: Episode 01 (Sn 1 Ep 1)")
    if ($0 ~ /<\/div>/) {
        if (episodeDescription == "") {
            if (episodeType == "T") {
                episodeDescription = episodeTitle
                # print "==> episodeDescription from title = " episodeDescription > "/dev/stderr"
            } else {
                print "==> No description: " shortEpisodeURL >> ERRORS
            }
        }
        if (episodeDescription ~ /^PR \|/)
            sub (/^PR \| /,"",episodeDescription)
        # print "==> episodeDescription = \n" episodeDescription > "/dev/stderr"
        episodeLink = sprintf ("=HYPERLINK(\"%s\";\"%s, S%02d%s%02d, %s\"\)", episodeURL, showTitle,
                    seasonNumber, episodeType, episodeNumber, episodeTitle)
        # Print "episode" line
        printf ("%s\t\t\t%s\t\t\t\t\t%s\n", episodeLink, episodeDuration, episodeDescription)
        #
        # Make sure there is no carryover
        descriptionLinesFound = 0
        episodeLink = ""
        episodeURL =""
        shortEpisodeURL = ""
        episodeType = ""
        episodeNumber = ""
        episodeTitle = ""
        episodeDuration = ""
        episodeDescription =""
    }
}

### Wrap-up show processing - print on standard out

# Footer at end of file
#
/ "/dev/stderr"
    #  =HYPERLINK("https://watch.mhzchoice.com/gasmamman";"Gasmamman")
    showLink = "=HYPERLINK(\"" showURL "\";\"" showTitle "\")"
    #
    # Shows with only one season have a blank showSeasons
    if (showSeasons == "")
        showSeasons = 1
    # in most cases, showSeasons = the final season number, i.e.
    # a show with two seasons would have seasons 1 and 2
    finalSeason = showSeasons
    # Special case any discontinuous seasons, e.g. 2 seasons, but numbered 1 and 3
    if (showURL ~ /\/wallander$/)
        finalSeason = 3
    #
    # Wrap show, i.e. but only on final season in order to prevent multiples
    # print "==> " showURL " - seasonNumber = " seasonNumber  > "/dev/stderr"
    # print "==> " showTitle " - finalSeason = " finalSeason  > "/dev/stderr"
    if (seasonNumber > finalSeason ) {
        # This should be OK, as printing any single valid season will work - however ...
        printf ("==> Season number %d beyond final season %d: %s\n", seasonNumber, finalSeason,
                shortSeasonURL) >> ERRORS
    }
    if (seasonNumber == finalSeason ) {
        # Print "show" line
        printf ("%s\t%s\t\t\t%s\n", showLink, showSeasons, showDescriptor)
    }
    #
    #  =HYPERLINK("https://watch.mhzchoice.com/gasmamman/season:1";"Gasmamman, S01, Season 1")
    if (page2 != "yes") {
        seasonLink = sprintf ("=HYPERLINK(\"%s\";\"%s, S%02d, %s\"\)", seasonURL, showTitle, seasonNumber,
                   seasonTitle)
        # print "==> seasonURL = " seasonURL  > "/dev/stderr"
        # print "==> seasonLink = " seasonLink  > "/dev/stderr"
        # Don't print redundant showDescriptor for season 1
        if (seasonNumber == 1)
            showDescriptor = ""
        # Print "season" line
        printf ("%s\t\t%s\t\t%s\n", seasonLink, seasonEpisodes, showDescriptor)
    }
    #
    # Make sure there is no carryover
    showLink = ""
    showURL = ""
    showTitle = ""
    showSeasons = ""
    showDescriptor = ""
    # print "" > "/dev/stderr"
    #
    page2 = ""
    seasonLink = ""
    seasonURL = ""
    shortSeasonURL = ""
    seasonNumber = ""
    seasonTitle = ""
    seasonEpisodes = ""
}

# Produce a raw data spreadsheet from URLs found in https://watch.mhzchoice.com/sitemap.xml

# INVOCATION
#    awk -v ERRORS=$ERRORS -v RAW_TITLES=$RAW_TITLES -f getMHzFromSitemap.awk >>$UNSORTED

# Field numbers
# 1 Title  2 Seasons  3 Episodes  4 Duration  5 Genre  6 Country  7 Language  8 Rating  9 Description

### Begin season processing

# Determine whether this is a page 2
#    <meta name="apple-itunes-app" content="app-id=1096194231, \
#        app-argument=https://mhzchoice.vhx.tv/detective-montalbano?page=2">
/<meta name="apple-itunes-app" content=".*?page=2">/ {
    page2 = "yes"
    next
}

# Season Title & Season URL
#    <form class="form"><input value="https://watch.mhzchoice.com/gasmamman/season:1" type="text" \
#        class="text text-center border-none site-background-color site-font-secondary-color" /></form>
# This returns incorrect values if page2 == "yes", but those values are never used
/<form class="form">/ {
    split ($0,fld,"\"")
    seasonURL = fld[4]
    shortSeasonURL = seasonURL
    sub (/.*watch/,"watch",shortSeasonURL)
    split (seasonURL,fld,":")
    seasonNumber = fld[3]
    seasonTitle = "Season " seasonNumber
    # print "==> seasonURL = " seasonURL > "/dev/stderr"
    # print "==> seasonNumber = " seasonNumber > "/dev/stderr"
    # print "==> seasonTitle = " seasonTitle > "/dev/stderr"
    next
}

# Season episodes
#

#      9 Episodes
#

# Extract only the number of episodes, # but if this is page 2 skip to avoid double counting
/<h2 class=.*content-label/,/<\/h2>/ {
    sub (/^ */,"")
    if ($0 ~ / Episode/) {
        seasonEpisodes = $1
        next
    }
}

### Begin show processing

# Show Title
#    <title>Gasmamman - MHz Choice</title>
/<title>/ {
    split ($0,fld,"[<>]")
    showTitle = fld[3]
    sub (" - MHz Choice","",showTitle)
    gsub (/'/,"'",showTitle)
    if (match (showTitle, /^The /)) {
        showTitle = substr(showTitle, 5) ", The"
    }
    print showTitle >> RAW_TITLES
    # print "==> showTitle = " showTitle > "/dev/stderr"
    next
}

# Show Descriptor
#    <meta name="description" content="DRAMA - CRIME | SWEDEN | SWEDISH WITH ENGLISH SUBTITLES | TV-14
#    Alexandra Rapaport stars as a suburban mom pulled into the criminal \
#        underworld to pay off her murdered husband’s debts.">
#
# There should be four header fields prior to the description
/<meta name="description" content="/,/">/ {
     # if we're on the first line of this block ...
    if ($0 ~ /name="description" content="/) {
        headerAdded = "no"
        sub (/.*name="description" content="/,"")
        # Special processing for "Arde Madrid: Burn Madrid Burn" which is missing a rating
        if ($0 ~ /COMEDY \| SPAIN \| SPANISH WITH ENGLISH SUBTITLES \| $/ && showTitle ~ /Arde Madrid:/) {
            printf ("==> Added TV-MA Rating to \"%s\"\n", showTitle) >> ERRORS
            $0 = "COMEDY \| SPAIN \| SPANISH WITH ENGLISH SUBTITLES \| TV-MA"
        }
    }
    # If we find a header, clean it up and put it before the description
    if ($0 ~ /\| {1,2}TV-/) {
        sub (/WITH ENGLISH SUBTITLES /,"")
        sub (/SCANDINAVIAN CRIME FICTION/,"Sweden")
        sub (/NONFICTION - DOCUMENTARY/,"Documentary")
        sub (/NON-FICTION - DOCUMENTARY/,"Documentary")
        gsub (/ \| {1,2}/,"|")
        sub (/\r/,"")
        # Split out header fields
        numFields = split ($0,fld,"\|")
        # lowercase everything but the first character in all fields but the last
        for (i = 1; i < numFields; ++i) {
            fld[i] = substr(fld[i],1,1) tolower(substr(fld[i],2))
            # uppercase the first character of any second word
            if (match (fld[i],/ /)) {
                fld[i] = substr(fld[i],1,RSTART) toupper(substr(fld[i],RSTART+1,1)) (substr(fld[i],RSTART+2))
            }
        }
        # Put the finalized header before the description
        if (numFields > 3 ) {
            sub ("Drama-crime","Drama - crime",fld[1])
            gsub (" ","",fld[4])
            showDescriptor =  fld[1] "\t" fld[2] "\t" fld[(numFields-1)] "\t" fld[(numFields)] "\t"
            headerAdded = "yes"
        }
    } else {
        # if we didn't find a header in this block, add a blank one
        if (headerAdded == "no") {
            printf ("==> Added blank header for \"%s\"\n", showTitle) >> ERRORS
            showDescriptor = "\t\t\t\t"
        }
        # We found a description, clean it up and add it
        gsub (/  */," ")
        gsub (/'/,"'")
        gsub (/"/,"\"")
        gsub (/&/,"\\&")
        gsub (/‘/,"’")
        gsub (/’/,"’")
        gsub (/“/,"“")
        gsub (/”/,"”")
        gsub (/\r/," ")
        # if it's not the last line of the description, add it
        if ($0 !~ /"\>/) {
            printf ("==> Multi line description in \"%s\"\n", showTitle) >> ERRORS
            showDescriptor = showDescriptor $0
        } else {
            # if it's the last line of the description, add it
            sub (/"\>/,"")
            showDescriptor = showDescriptor $0
        }
    }
    # print "==> showDescriptor = " showDescriptor > "/dev/stderr"
    next
}

# Show URL
#    <meta property="og:url" content="https://watch.mhzchoice.com/gasmamman">
/<meta property="og:url" content=/ {
    split ($0,fld,"\"")
    showURL = fld[4]
    # print "==> showURL = " showURL > "/dev/stderr"
    next
}

# Show seasons
#

#        3 Seasons
#

# Extract only the number of seasons, # but if this is page 2 skip to avoid double counting
/<h2 class=.*collection-stats"/,/<\/h2>/ {
    sub (/^ */,"")
    # Only if there are two or more seasons, a show with only one season doesn't have this
    if ($0 ~ / Season/) {
        showSeasons = $1
        next
    }
}

### Begin episode processing

# Episode URL(s)
#

#
/
/,/<a href="https:/ {
    if ($0 ~ / episodeURL = " episodeURL > "/dev/stderr"
        next
    }
}

# Episode Duration(s)
#
44:15

# Extract the duration
/<div class="duration-container/ {
    split ($0,fld,"[<>]")
    episodeDuration = fld[3]
    gsub (/ /,"",episodeDuration)
    # Spreadsheets decipher 2 part durations as time-of-day so make sure they're 3 parts
    if (split (episodeDuration, tm, ":") == 2)
        episodeDuration = "00:" episodeDuration
    # print "==> episodeDuration = " episodeDuration > "/dev/stderr"
    next
}

# Episode Title(s)
#
 \
#        Gåsmamman: Episode 01 (Sn 1 Ep 1)

/<h3 class="tooltip-item-title/{
    split ($0,fld,"[<>]")
    episodeTitle = fld[5]
    gsub (/'/,"'",episodeTitle)
    gsub (/"/,"\"\"",episodeTitle)
    gsub (/&/,"\\&",episodeTitle)
    # If start of episodeTitle == showTitle ": ", remove the redundant part.
    if ((match (episodeTitle, showTitle ": ")) == 1) {
        episodeTitle = substr(episodeTitle, RLENGTH + 1)
    }
    # print "==> episodeTitle = " episodeTitle > "/dev/stderr"
    #
    # If there is a trailing (Sn 1 Ep 1), remove it
    # Handle normal (Sn 1 Ep 1) with variations in spacing and capitalization
    # and ones missing the second letter (Sn 1 E 1), (S1 E1), or wrong second letter (Sm 1 Ep 1)
    if (match (episodeTitle,\
        /[ ]*\(S[Nnm]*[ ]*[[:digit:]]{1,2}[ ]+[Ee][Pp]*[ ]*[[:digit:]]{1,3}[[:space:]]*\)/))  {
        sub (/[ ]*\(S[Nnm]*[ ]*[[:digit:]]{1,2}[ ]+[Ee][Pp]*[ ]*[[:digit:]]{1,3}[[:space:]]*\)/,\
             "",episodeTitle)
        # print "==> episodeTitle = " episodeTitle > "/dev/stderr"
    }
    #
    # Default episodeType to "E"
    episodeType = "E"
    # If episode is a BONUS:, set episodeType to "X"
    if (episodeTitle ~ /BONUS|Montalbano and Me/)
        episodeType = "X"
    # If episode is a Trailer (i.e. First look), set episodeType to "T"
    if (episodeTitle ~ /^PR \|/) {
        episodeType = "T"
        seasonEpisodes = seasonEpisodes - 1
    }
    # print "==> episodeType = " episodeType > "/dev/stderr"
    next
}

# Episode Number(s)
#

#         Episode 1
#

/
<span class='media-identifier/,/<\/div>/ {
    sub (/^ */,"")
    if ($0 ~ /Episode /) {
        episodeNumber = $2
        if (showTitle == "Detective Montalbano" && page2 == "yes") {
            oldEpisodeNumber = episodeNumber
            episodeNumber += 24
            printf ("==> Changed E%02d to %s%02d: %s\n", oldEpisodeNumber, episodeType, \
                    episodeNumber, shortEpisodeURL) >> ERRORS
        }
        # print "==> episodeNumber = " episodeNumber > "/dev/stderr"
        next
    }

### Wrap-up episode processing when Episode Description is found
### print only on LONG_SPREADSHEET
    # print $0 > "/dev/stderr"

    # Episode Description(s)
    #

    #
Preparing for her sister's wedding, Sonja's idyllic life is shattered by tragedy.
    #

    if ($0 ~ /
/) {
        split ($0,fld,"[<>]")
        paragraph = fld[3]
        gsub (/&/,"\\&",paragraph)
        # Could be in multiple paragraphs
        descriptionLinesFound += 1
        if (paragraph != "")
            episodeDescription = episodeDescription (descriptionLinesFound == 1 ? "" : " ") paragraph
        gsub (/&/,"\\&",episodeDescription)
        # print "descriptionLinesFound = " descriptionLinesFound > "/dev/stderr"
        # print "==> episodeDescription from
 = \n" episodeDescription > "/dev/stderr"
        next
    }
    #  =HYPERLINK("https://watch.mhzchoice.com/gasmamman/season:1/videos/gasmamman-episode-01-sn-1-ep-1-1";\
    #  "Gasmamman, S01E01, Gåsmamman: Episode 01 (Sn 1 Ep 1)")
    if ($0 ~ /<\/div>/) {
        if (episodeDescription == "") {
            if (episodeType == "T") {
                episodeDescription = episodeTitle
                # print "==> episodeDescription from title = " episodeDescription > "/dev/stderr"
            } else {
                print "==> No description: " shortEpisodeURL >> ERRORS
            }
        }
        if (episodeDescription ~ /^PR \|/)
            sub (/^PR \| /,"",episodeDescription)
        # print "==> episodeDescription = \n" episodeDescription > "/dev/stderr"
        episodeLink = sprintf ("=HYPERLINK(\"%s\";\"%s, S%02d%s%02d, %s\"\)", episodeURL, showTitle,
                    seasonNumber, episodeType, episodeNumber, episodeTitle)
        # Print "episode" line
        printf ("%s\t\t\t%s\t\t\t\t\t%s\n", episodeLink, episodeDuration, episodeDescription)
        #
        # Make sure there is no carryover
        descriptionLinesFound = 0
        episodeLink = ""
        episodeURL =""
        shortEpisodeURL = ""
        episodeType = ""
        episodeNumber = ""
        episodeTitle = ""
        episodeDuration = ""
        episodeDescription =""
    }
}

### Wrap-up show processing - print on standard out

# Footer at end of file
#
/ "/dev/stderr"
    #  =HYPERLINK("https://watch.mhzchoice.com/gasmamman";"Gasmamman")
    showLink = "=HYPERLINK(\"" showURL "\";\"" showTitle "\")"
    #
    # Shows with only one season have a blank showSeasons
    if (showSeasons == "")
        showSeasons = 1
    # in most cases, showSeasons = the final season number, i.e.
    # a show with two seasons would have seasons 1 and 2
    finalSeason = showSeasons
    # Special case any discontinuous seasons, e.g. 2 seasons, but numbered 1 and 3
    if (showURL ~ /\/wallander$/)
        finalSeason = 3
    #
    # Wrap show, i.e. but only on final season in order to prevent multiples
    # print "==> " showURL " - seasonNumber = " seasonNumber  > "/dev/stderr"
    # print "==> " showTitle " - finalSeason = " finalSeason  > "/dev/stderr"
    if (seasonNumber > finalSeason ) {
        # This should be OK, as printing any single valid season will work - however ...
        printf ("==> Season number %d beyond final season %d: %s\n", seasonNumber, finalSeason,
                shortSeasonURL) >> ERRORS
    }
    if (seasonNumber == finalSeason ) {
        # Print "show" line
        printf ("%s\t%s\t\t\t%s\n", showLink, showSeasons, showDescriptor)
    }
    #
    #  =HYPERLINK("https://watch.mhzchoice.com/gasmamman/season:1";"Gasmamman, S01, Season 1")
    if (page2 != "yes") {
        seasonLink = sprintf ("=HYPERLINK(\"%s\";\"%s, S%02d, %s\"\)", seasonURL, showTitle, seasonNumber,
                   seasonTitle)
        # print "==> seasonURL = " seasonURL  > "/dev/stderr"
        # print "==> seasonLink = " seasonLink  > "/dev/stderr"
        # Don't print redundant showDescriptor for season 1
        if (seasonNumber == 1)
            showDescriptor = ""
        # Print "season" line
        printf ("%s\t\t%s\t\t%s\n", seasonLink, seasonEpisodes, showDescriptor)
    }
    #
    # Make sure there is no carryover
    showLink = ""
    showURL = ""
    showTitle = ""
    showSeasons = ""
    showDescriptor = ""
    # print "" > "/dev/stderr"
    #
    page2 = ""
    seasonLink = ""
    seasonURL = ""
    shortSeasonURL = ""
    seasonNumber = ""
    seasonTitle = ""
    seasonEpisodes = ""
}