aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPřemysl Janouch <p.janouch@gmail.com>2014-07-31 02:31:34 +0200
committerPřemysl Janouch <p.janouch@gmail.com>2014-07-31 02:34:02 +0200
commitba3f4e620c259c33d0d5da17e89eea922be0e4cd (patch)
tree00a81a6d265bc6f56242bb13009e5b712b18a7c7
parentf62dbe954657de94cc938f44d02fdab88597c87a (diff)
downloadxK-ba3f4e620c259c33d0d5da17e89eea922be0e4cd.tar.gz
xK-ba3f4e620c259c33d0d5da17e89eea922be0e4cd.tar.xz
xK-ba3f4e620c259c33d0d5da17e89eea922be0e4cd.zip
script: add uncons/first/rest/>/>=/<=/!=/join
-rwxr-xr-xplugins/script71
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);