X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=lists.lisp;h=c33d845148e801d06f68524b746513023b88ba72;hp=b51c41a5072c396e1bf0a3f7ead8d292d14226be;hb=54cd6cb1b9550ac2310e2c6dffc9cdecd2bdccd3;hpb=03712fbb06acbb103602bae10f41aeae7fa05127 diff --git a/lists.lisp b/lists.lisp index b51c41a..c33d845 100644 --- a/lists.lisp +++ b/lists.lisp @@ -7,8 +7,6 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id$ -;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; ;;;; KMRCL users are granted the rights to distribute and use this software @@ -73,14 +71,19 @@ 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)))))) +(defun flatten (tree) + (let ((result '())) + (labels ((scan (item) + (if (consp item) + (map nil #'scan item) + (push item result)))) + (scan tree)) + (nreverse result))) ;;; Keyword functions +;; ECL doesn't allow FOR clauses after UNTIL. +#-ecl (defun remove-keyword (key arglist) (loop for sublist = arglist then rest until (null sublist) for (elt arg . rest) = sublist @@ -160,8 +163,8 @@ (setf (cdr ,elem) ,val)) (,alist (setf (cdr (last ,alist)) (list (cons ,akey ,val)))) - (t - (setf ,alist (list (cons ,akey ,val))))) + (t + (setf ,alist (list (cons ,akey ,val))))) ,alist))) (defun get-alist (key alist &key (test #'eql)) @@ -172,6 +175,14 @@ (update-alist key value alist :test test) value) +(defun remove-alist (key alist &key (test #'eql)) + "Removes a key from an alist." + (remove key alist :test test :key #'car)) + +(defun delete-alist (key alist &key (test #'eql)) + "Deletes a key from an alist." + (delete key alist :test test :key #'car)) + (defun alist-plist (alist) (apply #'append (mapcar #'(lambda (x) (list (car x) (cdr x))) alist)))