X-Git-Url: http://git.hcoop.net/jackhill/mal.git/blobdiff_plain/ece70f970306f819b148979c3d17f266c7e08146..fbfe6784d2db983018340e4e1492d8d017029867:/impls/awk/step7_quote.awk

diff --git a/impls/awk/step7_quote.awk b/impls/awk/step7_quote.awk
index d8e963e2..c089c03f 100644
--- a/impls/awk/step7_quote.awk
+++ b/impls/awk/step7_quote.awk
@@ -9,69 +9,82 @@ function READ(str)
 	return reader_read_str(str)
 }
 
-function is_pair(ast)
+# Return 0, an error or the unquote argument (second element of ast).
+function starts_with(ast, sym,    idx, len)
 {
-	return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
+	if (ast !~ /^\(/)
+		return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (!len || types_heap[idx][0] != sym)
+		return 0
+	if (len != 2)
+		return  "!\"'" sym "' expects 1 argument, not " (len - 1) "."
+	return types_heap[idx][1]
 }
 
-function quasiquote(ast,    i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
+function quasiquote(ast,    new_idx, ret, ast_idx, elt_i, elt, previous)
 {
-	if (!is_pair(ast)) {
+	if (ast !~ /^[(['{]/) {
+		return ast
+	}
+	if (ast ~ /['\{]/) {
 		new_idx = types_allocate()
 		types_heap[new_idx][0] = "'quote"
 		types_heap[new_idx][1] = ast
 		types_heap[new_idx]["len"] = 2
 		return "(" new_idx
 	}
-	idx = substr(ast, 2)
-	first = types_heap[idx][0]
-	if (first == "'unquote") {
-		if (types_heap[idx]["len"] != 2) {
-			len = types_heap[idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(ret = types_heap[idx][1])
+	ret = starts_with(ast, "'unquote")
+	if (ret ~ /^!/) {
 		types_release(ast)
 		return ret
 	}
-
-	first_idx = substr(first, 2)
-	if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
-		if (types_heap[first_idx]["len"] != 2) {
-			len = types_heap[first_idx]["len"]
+	if (ret) {
+		types_addref(ret)
+		types_release(ast)
+		return ret
+	}
+	new_idx = types_allocate()
+	types_heap[new_idx]["len"] = 0
+	ast_idx = substr(ast, 2)
+	for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
+		elt = types_heap[ast_idx][elt_i]
+		ret = starts_with(elt, "'splice-unquote")
+		if (ret ~ /^!/) {
+			types_release("(" new_idx)
 			types_release(ast)
-			return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
+			return ret
 		}
-		types_addref(first = types_heap[first_idx][1])
-		verb = "'concat"
-	} else {
-		types_addref(first)
-		first = quasiquote(first)
-		if (first ~ /^!/) {
-			types_release(ast)
-			return first
+		if (ret) {
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'concat"
+			types_heap[new_idx][1] = types_addref(ret)
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		} else {
+			ret = quasiquote(types_addref(elt))
+			if (ret ~ /^!/) {
+				types_release(ast)
+				return ret
+			}
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'cons"
+			types_heap[new_idx][1] = ret
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
 		}
-		verb = "'cons"
 	}
-	lst_idx = types_allocate()
-	len = types_heap[idx]["len"]
-	for (i = 1; i < len; ++i) {
-		types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
+	if (ast ~ /^\[/) {
+		previous = "(" new_idx
+		new_idx = types_allocate()
+		types_heap[new_idx][0] = "'vec"
+		types_heap[new_idx][1] = previous
+		types_heap[new_idx]["len"] = 2
 	}
-	types_heap[lst_idx]["len"] = len - 1
 	types_release(ast)
-	ret = quasiquote("(" lst_idx)
-	if (ret ~ /^!/) {
-		types_release(first)
-		return ret
-	}
-
-	new_idx = types_allocate()
-	types_heap[new_idx][0] = verb
-	types_heap[new_idx][1] = first
-	types_heap[new_idx][2] = ret
-	types_heap[new_idx]["len"] = 3
 	return "(" new_idx
 }
 
@@ -316,6 +329,15 @@ function EVAL(ast, env,    body, new_ast, ret, idx, len, f, f_idx, ret_env)
 			types_release(ast)
 			env_release(env)
 			return body
+		case "'quasiquoteexpand":
+			env_release(env)
+			if (len != 2) {
+				types_release(ast)
+				return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
+			}
+			types_addref(body = types_heap[idx][1])
+			types_release(ast)
+			return quasiquote(body)
 		case "'quasiquote":
 			if (len != 2) {
 				types_release(ast)