diff options
| -rwxr-xr-x | plugins/script | 71 |
1 files changed, 64 insertions, 7 deletions
diff --git a/plugins/script b/plugins/script index 9c62399..78e0217 100755 --- a/plugins/script +++ b/plugins/script @@ -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); |