script: add uncons/first/rest/>/>=/<=/!=/join
This commit is contained in:
		
							parent
							
								
									f62dbe9546
								
							
						
					
					
						commit
						ba3f4e620c
					
				| @ -1009,6 +1009,28 @@ defn (fn_cat) | |||||||
| 	return true; | 	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 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | // - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||||||
| 
 | 
 | ||||||
| static bool | 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 | // TODO: implement more functions; try to avoid writing it in C | ||||||
| // | //   length -- length of a list/string | ||||||
| //   join { list delim -- string } -- string join -> script this |  | ||||||
| // |  | ||||||
| //   -, /, %, ** -- arithmetic | //   -, /, %, ** -- 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 | //   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 | static void | ||||||
| init_runtime_library (void) | init_runtime_library (void) | ||||||
| { | { | ||||||
|  | 	init_runtime_library_scripts (); | ||||||
|  | 
 | ||||||
| 	// Type detection | 	// Type detection | ||||||
| 	register_handler ("string?",  fn_is_string); | 	register_handler ("string?",  fn_is_string); | ||||||
| 	register_handler ("word?",    fn_is_word); | 	register_handler ("word?",    fn_is_word); | ||||||
| @ -1680,6 +1736,7 @@ init_runtime_library (void) | |||||||
| 	register_handler ("unit",     fn_unit); | 	register_handler ("unit",     fn_unit); | ||||||
| 	register_handler ("cons",     fn_cons); | 	register_handler ("cons",     fn_cons); | ||||||
| 	register_handler ("cat",      fn_cat); | 	register_handler ("cat",      fn_cat); | ||||||
|  | 	register_handler ("uncons",   fn_uncons); | ||||||
| 
 | 
 | ||||||
| 	// Arithmetic operations | 	// Arithmetic operations | ||||||
| 	register_handler ("*",        fn_times); | 	register_handler ("*",        fn_times); | ||||||
|  | |||||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user