r11859: Canonicalize whitespace
[kmrcl.git] / lists.lisp
index dfa9d386d25d5c9f100c317372442b3ef15adcff..b51c41a5072c396e1bf0a3f7ead8d292d14226be 100644 (file)
   "Strip from tree of atoms that satistify predicate"
   (if (atom tree)
       (unless (funcall pred tree)
   "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))
     (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))
       (cond
        ((and car-strip (atom (cadr tree)) (null cdr-strip))
-       (list car-strip))
+        (list car-strip))
        ((and car-strip cdr-strip)
        ((and car-strip cdr-strip)
-       (cons car-strip cdr-strip))
+        (cons car-strip cdr-strip))
        (car-strip
        (car-strip
-       car-strip)
+        car-strip)
        (cdr-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))
 
 (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))
       (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)
 
 (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)
 
 ;;; 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
 
 (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)
 
 (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)
   (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 ""))
        ""))
 
 
 (defun mapcar-append-string (func v &optional (accum ""))
-  "Concatenate results of mapcar lambda calls"  
+  "Concatenate results of mapcar lambda calls"
   (aif (car v)
   (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)
        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))
   (let ((a (car la))
-       (b (car lb)))
+        (b (car lb)))
     (if (and a b)
       (concatenate 'string (funcall func a b)
     (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 ""))
 (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))
   (let ((a (car la))
-       (b (car lb)))
+        (b (car lb)))
     (if (and a b)
     (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)
       accum)))
 
 (defun append-sublists (list)
 (defmacro update-alist (akey value alist &key (test '#'eql) (key '#'identity))
   "Macro to support below (setf get-alist)"
   (let ((elem (gensym "ELEM-"))
 (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))
     `(let ((,elem (assoc ,akey ,alist :test ,test :key ,key))
-          (,val ,value))
+           (,val ,value))
        (cond
        (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))
        ,alist)))
 
 (defun get-alist (key alist &key (test #'eql))
   (let ((pos (gensym)))
     `(let ((,pos (member ,pkey ,plist :test ,test)))
        (if ,pos
   (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)))
 
 
 (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))))))