From f62dbe954657de94cc938f44d02fdab88597c87a Mon Sep 17 00:00:00 2001
From: Přemysl Janouch <p.janouch@gmail.com>
Date: Thu, 31 Jul 2014 00:48:01 +0200
Subject: script: fix call/dip, add fold/each/unit/cons/cat

---
 plugins/script | 137 ++++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 120 insertions(+), 17 deletions(-)

diff --git a/plugins/script b/plugins/script
index 34ca379..9c62399 100755
--- a/plugins/script
+++ b/plugins/script
@@ -929,37 +929,83 @@ defn (fn_drop)
 defn (fn_swap)
 {
 	check_stack (2);
-	struct item *first = pop (ctx);
 	struct item *second = pop (ctx);
-	push (ctx, first);
+	struct item *first  = pop (ctx);
 	push (ctx, second);
+	push (ctx, first);
 	return true;
 }
 
 defn (fn_call)
 {
 	check_stack (1);
-	struct item *item = pop (ctx);
-	bool success;
-	// XXX: this behaves differently from if/map/filter
-	if (item->type == ITEM_LIST)
-		success = execute (ctx, get_list (item));
-	else
-		success = execute (ctx, item);
-	item_free (item);
+	struct item *script = pop (ctx);
+	bool success = check_type (ctx, script, ITEM_LIST)
+		&& execute (ctx, get_list (script));
+	item_free (script);
 	return success;
 }
 
 defn (fn_dip)
 {
 	check_stack (2);
+	struct item *script = pop (ctx);
+	struct item *item   = pop (ctx);
+	bool success = check_type (ctx, script, ITEM_LIST)
+		&& execute (ctx, get_list (script));
+	if (success)
+		push (ctx, item);
+	else
+		item_free (item);
+	item_free (script);
+	return success;
+}
+
+defn (fn_unit)
+{
+	check_stack (1);
+	struct item *item = pop (ctx);
+	push (ctx, new_list (item));
+	return true;
+}
+
+defn (fn_cons)
+{
+	check_stack (2);
+	struct item *list = pop (ctx);
 	struct item *item = pop (ctx);
-	if (!fn_call (ctx))
+	bool success = check_type (ctx, list, ITEM_LIST);
+	item->next = get_list (list);
+	((struct item_list *) list)->head = item;
+	if (success)
+		push (ctx, list);
+	else
+		item_free (list);
+	return success;
+}
+
+defn (fn_cat)
+{
+	check_stack (2);
+	struct item *scnd = pop (ctx);
+	struct item *frst = pop (ctx);
+	if (!check_type (ctx, frst, ITEM_LIST)
+	 || !check_type (ctx, scnd, ITEM_LIST))
 	{
-		item_free (item);
+		item_free (frst);
+		item_free (scnd);
 		return false;
 	}
-	push (ctx, item);
+
+	// XXX: we shouldn't have to do this in O(n)
+	struct item **tail = &((struct item_list *) frst)->head;
+	while (*tail)
+		tail = &(*tail)->next;
+	*tail = get_list (scnd);
+	push (ctx, frst);
+
+	((struct item_list *) scnd)->head = NULL;
+	item_free (scnd);
 	return true;
 }
 
@@ -1054,7 +1100,7 @@ defn (fn_try)
 	bool success = false;
 	if (!check_type (ctx, try,     ITEM_LIST)
 	 || !check_type (ctx, catch,   ITEM_LIST))
-	 goto fail;
+		goto fail;
 
 	if (!execute (ctx, get_list (try)))
 	{
@@ -1163,6 +1209,59 @@ fail:
 	return success;
 }
 
+defn (fn_fold)
+{
+	check_stack (3);
+	struct item *op   = pop (ctx);
+	struct item *null = pop (ctx);
+	struct item *list = pop (ctx);
+	bool success = false;
+	if (!check_type (ctx, op,   ITEM_LIST)
+	 || !check_type (ctx, list, ITEM_LIST))
+	{
+		item_free (null);
+		goto fail;
+	}
+
+	push (ctx, null);
+	for (struct item *iter = get_list (list); iter; iter = iter->next)
+	{
+		push (ctx, new_clone (iter));
+		if (!execute (ctx, get_list (op)))
+			goto fail;
+	}
+	success = true;
+
+fail:
+	item_free (op);
+	item_free (list);
+	return success;
+}
+
+defn (fn_each)
+{
+	check_stack (2);
+	struct item *op   = pop (ctx);
+	struct item *list = pop (ctx);
+	bool success = false;
+	if (!check_type (ctx, op,   ITEM_LIST)
+	 || !check_type (ctx, list, ITEM_LIST))
+		goto fail;
+
+	for (struct item *iter = get_list (list); iter; iter = iter->next)
+	{
+		push (ctx, new_clone (iter));
+		if (!execute (ctx, get_list (op)))
+			goto fail;
+	}
+	success = true;
+
+fail:
+	item_free (op);
+	item_free (list);
+	return success;
+}
+
 // - - Arithmetic  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 // XXX: why not a `struct item_string *` argument?
@@ -1534,16 +1633,13 @@ item_list_to_str (const struct item *script, struct buffer *buf)
 
 // TODO: implement more functions; try to avoid writing it in C
 //
-//   ? fold
 //   join { list delim -- string } -- string join -> script this
 //
-//   concat { list list -- list } -- join two lists
 //   -, /, %, ** -- arithmetic
 //   >, !=, <=, >= -- comparison
 //   first -- first character of a string, first element in a list
 //   rest -- [1:] of a string, the "tail" in a list
 //   at { value index -- sub-value } -- get n-th subvalue of a string/list
-//   cons { item value } -- prepend an item to the list/string
 //   <each> step { value program } -- foreach
 
 static void
@@ -1577,6 +1673,13 @@ init_runtime_library (void)
 	// List processing
 	register_handler ("map",      fn_map);
 	register_handler ("filter",   fn_filter);
+	register_handler ("fold",     fn_fold);
+	register_handler ("each",     fn_each);
+
+	// List manipulation
+	register_handler ("unit",     fn_unit);
+	register_handler ("cons",     fn_cons);
+	register_handler ("cat",      fn_cat);
 
 	// Arithmetic operations
 	register_handler ("*",        fn_times);
-- 
cgit v1.2.3-70-g09d2