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

script: add uncons/first/rest/>/>=/<=/!=/join

Browse Source
This commit is contained in:
Přemysl Eric Janouch 2014-07-31 02:31:34 +02:00
parent f62dbe9546
commit ba3f4e620c
1 changed files with 64 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
plugins/script
View File

@ -1009,6 +1009,28 @@ defn (fn_cat)
return true;
}
defn (fn_uncons)
{
check_stack (1);
struct item *list = pop (ctx);
if (!check_type (ctx, list, ITEM_LIST))
goto fail;
struct item *first = get_list (list);
if (!first)
{
ctx->error = strdup ("list is empty");
goto fail;
}
((struct item_list *) list)->head = first->next;
first->next = NULL;
push (ctx, first);
push (ctx, list);
return true;
fail:
item_free (list);
return false;
}
// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
static bool
@ -1632,19 +1654,53 @@ item_list_to_str (const struct item *script, struct buffer *buf)
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
// TODO: implement more functions; try to avoid writing it in C
//
// join { list delim -- string } -- string join -> script this
//
// length -- length of a list/string
// -, /, %, ** -- 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
// <each> step { value program } -- foreach
static void
init_runtime_library_scripts (void)
{
struct script
{
const char *name;
const char *definition;
}
scripts[] =
{
{ "swons", "swap cons" },
{ "first", "uncons drop" },
{ "rest", "uncons swap drop" },
{ ">", "swap <" },
{ "!=", "= not" },
{ "<=", "> not" },
{ ">=", "< not" },
// XXX: this is a bit crazy and does not work with an empty list
{ "join", "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop" },
};
for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
{
char *error = NULL;
struct item *script = parse (scripts[i].definition, &error);
if (error)
{
fprintf (stderr, "error parsing internal script `%s': %s=n",
scripts[i].definition, error);
free (error);
exit (EXIT_FAILURE);
}
register_script (scripts[i].name, script);
}
}
static void
init_runtime_library (void)
{
init_runtime_library_scripts ();
// Type detection
register_handler ("string?", fn_is_string);
register_handler ("word?", fn_is_word);
@ -1680,6 +1736,7 @@ init_runtime_library (void)
register_handler ("unit", fn_unit);
register_handler ("cons", fn_cons);
register_handler ("cat", fn_cat);
register_handler ("uncons", fn_uncons);
// Arithmetic operations
register_handler ("*", fn_times);