X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=lists.lisp;h=b51c41a5072c396e1bf0a3f7ead8d292d14226be;hp=dfa9d386d25d5c9f100c317372442b3ef15adcff;hb=03712fbb06acbb103602bae10f41aeae7fa05127;hpb=739b14ee8844dc777b174105646df3abcb865282 diff --git a/lists.lisp b/lists.lisp index dfa9d38..b51c41a 100644 --- a/lists.lisp +++ b/lists.lisp @@ -46,88 +46,88 @@ "Strip from tree of atoms that satistify predicate" (if (atom tree) (unless (funcall pred tree) - (if atom-processor - (funcall atom-processor tree) - tree)) + (if atom-processor + (funcall atom-processor tree) + tree)) (let ((car-strip (remove-from-tree-if pred (car tree) atom-processor)) - (cdr-strip (remove-from-tree-if pred (cdr tree) atom-processor))) + (cdr-strip (remove-from-tree-if pred (cdr tree) atom-processor))) (cond ((and car-strip (atom (cadr tree)) (null cdr-strip)) - (list car-strip)) + (list car-strip)) ((and car-strip cdr-strip) - (cons car-strip cdr-strip)) + (cons car-strip cdr-strip)) (car-strip - car-strip) + car-strip) (cdr-strip - cdr-strip))))) + cdr-strip))))) (defun find-tree (sym tree) "Finds an atom as a car in tree and returns cdr tree at that positions" (if (or (null tree) (atom tree)) nil (if (eql sym (car tree)) - (cdr tree) + (cdr tree) (aif (find-tree sym (car tree)) - it - (aif (find-tree sym (cdr tree)) - it - nil))))) + it + (aif (find-tree sym (cdr tree)) + it + nil))))) (defun flatten (lis) (cond ((atom lis) lis) - ((listp (car lis)) - (append (flatten (car lis)) (flatten (cdr lis)))) - (t (append (list (car lis)) (flatten (cdr lis)))))) + ((listp (car lis)) + (append (flatten (car lis)) (flatten (cdr lis)))) + (t (append (list (car lis)) (flatten (cdr lis)))))) ;;; Keyword functions (defun remove-keyword (key arglist) (loop for sublist = arglist then rest until (null sublist) - for (elt arg . rest) = sublist - unless (eq key elt) append (list elt arg))) + for (elt arg . rest) = sublist + unless (eq key elt) append (list elt arg))) (defun remove-keywords (key-names args) (loop for ( name val ) on args by #'cddr - unless (member (symbol-name name) key-names - :key #'symbol-name :test 'equal) - append (list name val))) + unless (member (symbol-name name) key-names + :key #'symbol-name :test 'equal) + append (list name val))) (defun mapappend (func seq) (apply #'append (mapcar func seq))) (defun mapcar-append-string-nontailrec (func v) - "Concatenate results of mapcar lambda calls" + "Concatenate results of mapcar lambda calls" (aif (car v) (concatenate 'string (funcall func it) - (mapcar-append-string-nontailrec func (cdr v))) + (mapcar-append-string-nontailrec func (cdr v))) "")) (defun mapcar-append-string (func v &optional (accum "")) - "Concatenate results of mapcar lambda calls" + "Concatenate results of mapcar lambda calls" (aif (car v) - (mapcar-append-string - func - (cdr v) - (concatenate 'string accum (funcall func it))) + (mapcar-append-string + func + (cdr v) + (concatenate 'string accum (funcall func it))) accum)) (defun mapcar2-append-string-nontailrec (func la lb) - "Concatenate results of mapcar lambda call's over two lists" + "Concatenate results of mapcar lambda call's over two lists" (let ((a (car la)) - (b (car lb))) + (b (car lb))) (if (and a b) (concatenate 'string (funcall func a b) - (mapcar2-append-string-nontailrec func (cdr la) (cdr lb))) + (mapcar2-append-string-nontailrec func (cdr la) (cdr lb))) ""))) - + (defun mapcar2-append-string (func la lb &optional (accum "")) - "Concatenate results of mapcar lambda call's over two lists" + "Concatenate results of mapcar lambda call's over two lists" (let ((a (car la)) - (b (car lb))) + (b (car lb))) (if (and a b) - (mapcar2-append-string func (cdr la) (cdr lb) - (concatenate 'string accum (funcall func a b))) + (mapcar2-append-string func (cdr la) (cdr lb) + (concatenate 'string accum (funcall func a b))) accum))) (defun append-sublists (list) @@ -152,16 +152,16 @@ (defmacro update-alist (akey value alist &key (test '#'eql) (key '#'identity)) "Macro to support below (setf get-alist)" (let ((elem (gensym "ELEM-")) - (val (gensym "VAL-"))) + (val (gensym "VAL-"))) `(let ((,elem (assoc ,akey ,alist :test ,test :key ,key)) - (,val ,value)) + (,val ,value)) (cond - (,elem - (setf (cdr ,elem) ,val)) - (,alist - (setf (cdr (last ,alist)) (list (cons ,akey ,val)))) - (t - (setf ,alist (list (cons ,akey ,val))))) + (,elem + (setf (cdr ,elem) ,val)) + (,alist + (setf (cdr (last ,alist)) (list (cons ,akey ,val)))) + (t + (setf ,alist (list (cons ,akey ,val))))) ,alist))) (defun get-alist (key alist &key (test #'eql)) @@ -186,18 +186,18 @@ (let ((pos (gensym))) `(let ((,pos (member ,pkey ,plist :test ,test))) (if ,pos - (progn - (setf (cadr ,pos) ,value) - ,plist) - (setf ,plist (append ,plist (list ,pkey ,value))))))) + (progn + (setf (cadr ,pos) ,value) + ,plist) + (setf ,plist (append ,plist (list ,pkey ,value))))))) (defun unique-slot-values (list slot &key (test 'eql)) (let ((uniq '())) (dolist (item list (nreverse uniq)) (let ((value (slot-value item slot))) - (unless (find value uniq :test test) - (push value uniq)))))) + (unless (find value uniq :test test) + (push value uniq))))))