p/xK
1
1
Fork 0
Code Issues 1 Pull Requests Releases 11 Wiki Activity

script: fix call/dip, add fold/each/unit/cons/cat

Browse Source
This commit is contained in:
Přemysl Eric Janouch 2014-07-31 00:48:01 +02:00
parent 053359aaf1
commit f62dbe9546
1 changed files with 121 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
plugins/script
View File

@ -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 *item = pop (ctx);
if (!fn_call (ctx))
{
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);
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 (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);