script: add uncons/first/rest/>/>=/<=/!=/join
This commit is contained in:
parent
f62dbe9546
commit
ba3f4e620c
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue