A buch of sequence functions
This commit is contained in:
@ -399,3 +399,40 @@
|
|||||||
(when (zerop n)
|
(when (zerop n)
|
||||||
(return-from nthtail tail))
|
(return-from nthtail tail))
|
||||||
(setq n (- n 1))))
|
(setq n (- n 1))))
|
||||||
|
|
||||||
|
(defmacro doindex (vars &rest body)
|
||||||
|
(let ((i '::i))
|
||||||
|
(list 'let (list (list i 0))
|
||||||
|
(list 'while (list '< i (list 'length (second vars)))
|
||||||
|
(apply 'list 'let (list (list (first vars) i))
|
||||||
|
body)
|
||||||
|
(list 'setq i (list '+ i 1))))))
|
||||||
|
|
||||||
|
(defmacro dovector (vars &rest body)
|
||||||
|
(let ((vec '::vec)
|
||||||
|
(i '::i)
|
||||||
|
(vh (head vars)))
|
||||||
|
(list 'let (list (list vec (second vars)))
|
||||||
|
(list 'doindex (list i vec)
|
||||||
|
(if (symbolp vh)
|
||||||
|
(apply 'list 'let (list (list vh (list 'aref vec i)))
|
||||||
|
body)
|
||||||
|
(apply 'list 'let (list (list (first vh) i)
|
||||||
|
(list (second vh) (list 'aref vec i)))
|
||||||
|
body))))))
|
||||||
|
|
||||||
|
(defun foreach (func seq)
|
||||||
|
(tcase seq
|
||||||
|
(hash-table (maphash func seq))
|
||||||
|
(list
|
||||||
|
(dolist (elt seq)
|
||||||
|
(funcall func elt)))
|
||||||
|
((or vector string)
|
||||||
|
(dovector (elt seq)
|
||||||
|
(funcall func elt)))))
|
||||||
|
|
||||||
|
(defun code-char (code)
|
||||||
|
(string [code]))
|
||||||
|
|
||||||
|
(defun char-code (str)
|
||||||
|
(aref str 0))
|
||||||
|
12
src/lisp.c
12
src/lisp.c
@ -2443,6 +2443,17 @@ DEFUN(hash_table_count, "hash-table-count", (LispVal * table)) {
|
|||||||
return make_lisp_integer(((LispHashtable *) table)->count);
|
return make_lisp_integer(((LispHashtable *) table)->count);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
DEFUN(maphash, "maphash", (LispVal * func, LispVal *table)) {
|
||||||
|
HT_FOREACH_VALID_INDEX(table, i) {
|
||||||
|
LispVal *args =
|
||||||
|
const_list(true, 2, HASH_KEY(table, i), HASH_VALUE(table, i));
|
||||||
|
WITH_CLEANUP(args, {
|
||||||
|
refcount_unref(Ffuncall(func, args)); //
|
||||||
|
});
|
||||||
|
}
|
||||||
|
return Qnil;
|
||||||
|
}
|
||||||
|
|
||||||
DEFUN(puthash, "puthash", (LispVal * table, LispVal *key, LispVal *value)) {
|
DEFUN(puthash, "puthash", (LispVal * table, LispVal *key, LispVal *value)) {
|
||||||
return refcount_ref(puthash(table, key, value));
|
return refcount_ref(puthash(table, key, value));
|
||||||
}
|
}
|
||||||
@ -3522,4 +3533,5 @@ static void register_symbols_and_functions(void) {
|
|||||||
REGISTER_FUNCTION(string, "(val)", "");
|
REGISTER_FUNCTION(string, "(val)", "");
|
||||||
REGISTER_FUNCTION(subvector, "(seq &opt start end)", "");
|
REGISTER_FUNCTION(subvector, "(seq &opt start end)", "");
|
||||||
REGISTER_FUNCTION(string_to_vector, "(str)", "");
|
REGISTER_FUNCTION(string_to_vector, "(str)", "");
|
||||||
|
REGISTER_FUNCTION(maphash, "(func table)", "");
|
||||||
}
|
}
|
||||||
|
@ -516,6 +516,7 @@ DECLARE_FUNCTION(hash_table_p, (LispVal * val));
|
|||||||
DECLARE_FUNCTION(make_hash_table, (LispVal * hash_fn, LispVal *eq_fn));
|
DECLARE_FUNCTION(make_hash_table, (LispVal * hash_fn, LispVal *eq_fn));
|
||||||
DECLARE_FUNCTION(copy_hash_table, (LispVal * table));
|
DECLARE_FUNCTION(copy_hash_table, (LispVal * table));
|
||||||
DECLARE_FUNCTION(hash_table_count, (LispVal * table));
|
DECLARE_FUNCTION(hash_table_count, (LispVal * table));
|
||||||
|
DECLARE_FUNCTION(maphash, (LispVal * func, LispVal *table));
|
||||||
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
|
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
|
||||||
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
|
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
|
||||||
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
|
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
|
||||||
|
Reference in New Issue
Block a user