Some cleanup, prunned deprecated functions.

Pascal J. Bourguignon [2017-01-21 18:37]
Some cleanup, prunned deprecated functions.
Filename
pjb-list.el
diff --git a/pjb-list.el b/pjb-list.el
index b3baf6e..efba5b7 100644
--- a/pjb-list.el
+++ b/pjb-list.el
@@ -11,14 +11,15 @@
 ;;;;AUTHORS
 ;;;;    <PJB> Pascal J. Bourguignon
 ;;;;MODIFICATIONS
+;;;;    2017-01-21 <pjb> Some cleanup, prunned deprecated functions.
 ;;;;    2011-06-01 <PJB> Added clean-alist, clean-plist, alist->plist and plist->alist.
 ;;;;    2006-03-23 <PJB> Added maptree.
-;;;;    199?-??-?? <PJB> Creation.
-;;;;    2001-11-30 <PJB> Added list-remove-elements.
 ;;;;    2002-12-03 <PJB> Common-Lisp'ized.
+;;;;    2001-11-30 <PJB> Added list-remove-elements.
+;;;;    199?-??-?? <PJB> Creation.
 ;;;;BUGS
 ;;;;LEGAL
-;;;;    Copyright Pascal J. Bourguignon 2002 - 2011
+;;;;    Copyright Pascal J. Bourguignon 2002 - 2017
 ;;;;
 ;;;;    This script is free software; you can redistribute it and/or
 ;;;;    modify it under the terms of the GNU  General Public
@@ -36,9 +37,6 @@
 ;;;;    59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 ;;;;******************************************************************************
 (require 'pjb-cl)
-(provide 'pjb-list)
-
-;; list-to-set list-to-set-sorted  ==> Use REMOVE-DUPLICATES

 (defun ensure-list (x) (if (listp x) x (list x)))

@@ -58,7 +56,6 @@ EXAMPLES: (iota 5) => (0 1 2 3 4)
         ((< item start) result)
       (push item result))))

-
 (defun flatten (tree)
   "
 RETURN: A tree containing all the elements of the `tree'.
@@ -77,11 +74,7 @@ RETURN: A tree containing all the elements of the `tree'.
        (setq tree (car tree)))
       (t
        (push (car tree) result)
-       (setq tree (cdr tree)))))
-  ) ;;flatten
-
-;;; (flatten '((((a) (b c) d) e) (f g) (h (i j (k) l) (()) (()()()))))
-
+       (setq tree (cdr tree))))))

 (defun maptree (function tree)
   "Call FUNCTION on all atoms in the cons tree TREE, building a similar
@@ -91,7 +84,6 @@ tree in the process which is returned."
         (t (cons (maptree function (car tree))
                  (maptree function (cdr tree))))))

-
 (defun depth (tree)
   "
 RETURN:     The depth of the tree.
@@ -103,9 +95,7 @@ RETURN:     The depth of the tree.
                  (do ((tree tree (cdr tree))
                       (results '()))
                      ((atom tree) results)
-                   (if (listp (car tree)) (push (depth (car tree)) results))))))
-  ) ;;depth
-
+                   (if (listp (car tree)) (push (depth (car tree)) results)))))))

 (defun deepest-rec (tree)
   "
@@ -119,9 +109,7 @@ SEE-ALSO:   deepest-iti
       ((every (lambda (item) (every (function atom) item)) subtree)
        (car subtree))
       (t
-       (deepest (apply 'concatenate 'list subtree)))))
-  ) ;;deepest-rec
-
+       (deepest (apply 'concatenate 'list subtree))))))

 (defun deepest-iti (tree)
   "
@@ -134,12 +122,10 @@ SEE-ALSO:   deepest-rec
                  (delete-if (function atom) tree)))
        ((or (null subtree)
             (every (lambda (item) (every (function atom) item)) subtree))
-        (if (null subtree) tree (car subtree))))
-  ) ;;deepest-iti
+        (if (null subtree) tree (car subtree)))))

 (defalias 'deepest 'deepest-iti)

-
 (defun nsplit-list-on-indicator (list indicator)
   "
 RETURN: a list of sublists of list (the conses from list are reused),
@@ -161,29 +147,9 @@ RETURN: a list of sublists of list (the conses from list are reused),
              (progn ;; keep
                (setq current next)
                (setq next (cdr current))
-               ))
-         ) ;;while
+               )))
     (push sublist result)
-    (nreverse result))
-  ) ;;nsplit-list-on-indicator
-
-
-(defun list-extract-predicate (liste predicate)
-  "
-RETURN:  A new list containing all the member of LISTE for which PREDICATE
-         returned non-nil. The elements are in the same order in the result
-         than they were in LISTE.
-EXAMPLE: (list-extract-predicate '( 1 2 3 4 5 6 ) 'oddp)
-         ==> (1 3 5)
-"
-  (message "Use CL remove-if-not instead of list-extract-predicate !")
-  (remove-if-not predicate liste)
-  ;;   (loop for item in liste
-  ;;         when (funcall predicate item)
-  ;;         collect item into result
-  ;;         finally return result)
-  ) ;;list-extract-predicate
-
+    (nreverse result)))

 (defun list-insert-separator (list separator)
   "
@@ -197,46 +163,7 @@ EXAMPLE: (list-insert-separator '(a b (d e f)  c) 'x)
        ((null rest) (nreverse result))
     (push separator result)
     (push (car rest) result)))
-
-
-(defun list-replace-member (list old new)
-  "
-RETURN:  A new list copy of `list' where the _first_ occurence of `old' (eq)
-         is replaced with `new'.
-EXAMPLE: (list-replace-member '(a b c a b c) 'b 'x)
-         ==> (a x c a b c)
-"
-  (message "Use CL substitute instead of list-replace-member !")
-  (substitute new old list)) ;;list-replace-member
-
-
-(defun list-replace-member-in-place (list old new)
-  "
-DO:      Modifies the list, replacing the _first_ occurence of `old' (equal)
-         with `new'.
-RETURN:  `list'
-EXAMPLE: (list-replace-member-in-place (list (concatenate 'string \"a\" \"b\")
-                                                \"c\" \"ab\") \"ab\" \"x\")
-         ==> (\"x\" \"c\" \"ab\")
-"
-  (message "Use CL nsubstitute instead of list-replace-member-in-place !")
-  (nsubstitute new old list)) ;;list-replace-member-in-place
-
-
-(defun list-replace-member-in-place-eq (list old new)
-  "
-DO:      Modifies the list, replacing the _first_ occurence of `old' (eq)
-         with `new'.
-RETURN:  `list'
-EXAMPLE: (list-replace-member-in-place-eq (list \"ab\" (setq s \"ab\") \"c\" s)
-                                           s \"x\")
-         ==> (\"ab\" \"x\" \"c\" \"ab\")
-"
-  (message "Use CL nsubstitute instead of list-replace-member-in-place-eq !")
-  (nsubstitute new old list :test (function eq))) ;;list-replace-member-in-place-eq

-
-
 (defun make-list-of-random-numbers (length)
   "
 RETURN:  A list of length `length' filled with random numbers.
@@ -244,10 +171,7 @@ RETURN:  A list of length `length' filled with random numbers.
   (loop while (< 0 length)
      collect (random most-positive-fixnum) into result
      do (setq length (1- length))
-     finally return result)
-  ) ;;make-list-of-random-numbers
-
-
+     finally return result))

 (defun assoc-setq (key value alist)
   "
@@ -257,19 +181,13 @@ RETURN:  A new alist with the assoc in alist with the KEY
   (let ((old (assoc key alist))
         (new (cons key value)))
     (if old (list-replace-member alist old new)
-        (cons new alist)))
-  ) ;;assoc-setq
-
+        (cons new alist))))

 (defun assoc-val (key alist)
   "
 RETURN: (cdr (assoc key alist)).
 "
-  (cdr (assoc key alist))
-  ) ;;assoc-val
-
-
-
+  (cdr (assoc key alist)))

 (defun list-remove-elements (list elements)
   "
@@ -282,70 +200,7 @@ NOTE:    The order of the elements is not conserved.
 EXAMPLE: (list-remove-elements '(a b c d e f) '(a c e))
          ==> (b d f)
 "
-  (remove-if (lambda (x) (member x elements)) list)
-  ;;   (loop for item in list
-  ;;         unless (member item elements)
-  ;;         collect item into result
-  ;;         finally return result)
-  ) ;;list-remove-elements
-
-
-
-(defun remove-nil (list)
-  "
-DO:      Remove all nil items in the `list'.
-RETURN:  A new list with the same elements as `list' but the nils.
-NOTE:    This is not a 'deep' function.
-EXAMPLE: (remove-nil '( a nil b ( c nil d ) e nil))
-         ==> (a b (c nil d) e)
-"
-  (message "Use CL (remove nil list) instead of (remove-nil list) !")
-  (remove nil list)
-  ;;   (loop for item in list
-  ;;         unless (null item)
-  ;;         collect item into result
-  ;;         finally return result)
-  ) ;;remove-nil
-
-
-(defun nremove-nil (list)
-  "
-DO:      Remove all nil items in-place in the `list'.
-RETURN:  The modified `list'.
-WARNING: As usual for these class of functions, the result may be a cons
-         different to the old `list' when the firsts conses are removed;
-         use: (setq list (nremove-nil list))
-EXAMPLE: (nremove-nil (setq s (copy-seq '( a nil b ( c nil d ) nil e nil))))
-         ==> (a b (c nil d) e)
-         s
-         ==> (a b (c nil d) e)
-         (nremove-nil (setq s (copy-seq '(nil nil b ( c nil d ) e nil))))
-         ==> (b (c nil d) e)
-         s
-         ==> (nil nil b (c nil d) e)
-"
-  (message "Use CL (delete nil list) instead of (nremove-nil list) !")
-  (delete nil list)
-  ;;   (unless (atom list)
-  ;;     ;; skip to first non-nil car.
-  ;;     (setq list (loop for first = list then (cdr first)
-  ;;                      while (and first (null (car first)))
-  ;;                      finally return first))
-  ;;     ;; since (not (null (car list))),
-  ;;     ;; we can take prev == list without problem.
-  ;;     (loop with prev = list
-  ;;           with rest = (cdr prev)
-  ;;           while rest
-  ;;           do (loop while (and rest (null (car rest)))
-  ;;                    do (setq rest (cdr rest)))
-  ;;           (setf (cdr prev) rest)
-  ;;           (setq prev rest
-  ;;                 rest (cdr rest)))
-  ;;     ) ;;unless
-  ;;   list
-  ) ;;nremove-nil
-
-
+  (remove-if (lambda (x) (member x elements)) list))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Double-Linked Lists
@@ -369,161 +224,19 @@ EXAMPLE: (setq d (list-to-double-linked-list '( a b c)))
      for current = (list element previous)
      unless head do (setq head current)
      when previous do (setf (cdr (cdr previous))  current)
-     finally return head)
-  ) ;;list-to-double-linked-list
-
-;; (setq x (list-to-double-linked-list '(a b c d e f)))
-;; (list (dll-node x) '/ (dll-previous x) '/ (dll-next x))
-;; (setq x (dll-next x))
-;; --> #1=(a nil . #2=(b #1# . #3=(c #2# . #4=(d #3# . #5=(e #4# f #5#)))))
-
+     finally return head))

 (defun dll-node     (dll-cons)
-  "
-RETURN:  The node in the `dll-cons' double-linked-list node.
-"
-  (car  dll-cons)
-  ) ;;dll-node
-
+  "The node in the `dll-cons' double-linked-list node."
+  (car  dll-cons))

 (defun dll-previous (dll-cons)
-  "
-RETURN:  The previous dll-cons in the `dll-cons' double-linked-list node.
-"
-  (cadr dll-cons)
-  ) ;;dll-previous
-
+  "The previous dll-cons in the `dll-cons' double-linked-list node."
+  (cadr dll-cons))

 (defun dll-next     (dll-cons)
-  "
-RETURN:  The next dll-cons in the `dll-cons' double-linked-list node.
-"
-  (cddr dll-cons)
-  ) ;;dll-next
-
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; ;; Sets
-
-
-;;; SEE: delete-duplicate remove-duplicate
-;;; (defun list-to-set (list)
-;;;   "
-;;; RETURN: a set, that is a list where duplicate elements from list are removed.
-;;; NOTE:   The complexity of this implementation is O(N^2) [N==(length list)],
-;;; "
-;;;   (loop with set = nil
-;;;         while list
-;;;         do
-;;;         (if (not (member (car list) set))
-;;;             (setq set (cons (car list) set)))
-;;;         (setq list (cdr list))
-;;;         finally return set)
-;;;   ) ;;list-to-set
-
-
-
-;;; (defun cons-lessp (a b)
-;;;   "PRIVATE.
-;;; RETURN: a<=b
-;;; "
-;;;   (do* ( (ap a (cdr ap))
-;;;          (ai (car ap) (car ap))
-;;;          (bp b (cdr bp))
-;;;          (bi (car bp) (car bp)) )
-;;;       ( (not (and ai bi (eq ai bi)))
-;;;         (any-lessp ai bi) )
-;;;     )
-;;;   ) ;;cons-lessp
-
-
-
-
-;;; (defun formated-lessp (a b)
-;;;   "PRIVATE.
-;;; RETURN: a<=b
-;;; "
-;;;   (string-lessp (format nil "~S" a) (format nil "~S" b))
-;;;   );;formated-lessp
-
-
-;;; (defun symbol-lessp (a b)
-;;;   "PRIVATE.
-;;; RETURN: a<=b
-;;; "
-;;;   (string-lessp (symbol-name a) (symbol-name b))
-;;;   );;symbol-lessp
-
-
-;;; (defun vector-lessp (a b)
-;;;   "PRIVATE.
-;;; RETURN: a<=b
-;;; "
-;;;   (if (= (length a) (length b))
-;;;       (loop for i from 0 below (length a)
-;;;             for ai = (aref a i)
-;;;             for bi = (aref b i)
-;;;             while (eq ai bi)
-;;;             ;;do (show ai bi)
-;;;             ;;finally (show ai bi) (show (or bi (not ai)))
-;;;             finally return (any-lessp ai bi))
-;;;     (< (length a) (length b)))
-;;;   );;vector-lessp
-
-
-;;; (defun any-lessp (a b)
-;;;   "PRIVATE.
-;;; RETURN: a<=b
-;;; "
-;;;   (if (eq (type-of a) (type-of b))
-;;;       (funcall
-;;;        (cdr (assoc
-;;;              (type-of a)
-;;;              '((bool-vector . vector-lessp)
-;;;                (buffer . formated-lessp)
-;;;                (char-table . vector-lessp)
-;;;                (compiled-function . vector-lessp)
-;;;                (cons . cons-lessp)
-;;;                (float . <=)
-;;;                (frame . formated-lessp)
-;;;                (integer . <=)
-;;;                (marker . <=)
-;;;                (overlay . formated-lessp)
-;;;                (process . formated-lessp)
-;;;                (string . string-lessp)
-;;;                (subr . formated-lessp)
-;;;                (symbol . symbol-lessp)
-;;;                (vector . vector-lessp)
-;;;                (window . formated-lessp)
-;;;                (window-configuration . formated-lessp)
-;;;                ))) a b)
-;;;     (string-lessp (symbol-name (type-of a))
-;;;                   (symbol-name (type-of b))))
-;;;   );;any-lessp
-
-
-;;; (defun list-to-set-sorted (list)
-;;;   "
-;;; RETURN: A set, that is a list where duplicate elements from `list' are removed.
-;;; NOTE:   This implementation first sorts the list, so its complexity should be
-;;;         of the order of O(N*(1+log(N))) [N==(length list)]
-;;;         BUT, it's still slower than list-to-set
-;;; "
-;;;   (if (null list)
-;;;       nil
-;;;     (let* ((sorted-list (sort list 'any-lessp))
-;;;            (first (car sorted-list))
-;;;            (rest  (cdr sorted-list))
-;;;            (set nil))
-;;;       (loop while rest do
-;;;         (if (eq first (car rest))
-;;;             (setq rest (cdr rest))
-;;;           (progn
-;;;             (push first set)
-;;;             (setq first (car rest)
-;;;                   rest  (cdr rest)))))
-;;;       set)));;list-to-set-sorted
-
+  "The next dll-cons in the `dll-cons' double-linked-list node."
+  (cddr dll-cons))

 (defun equiv (&rest args)
   (if (null args)
@@ -542,18 +255,14 @@ RETURN:  The next dll-cons in the `dll-cons' double-linked-list node.
             (push (list :class item) classes))
      finally (return (mapcar (function cdr) classes))))

-
-
 (defun clean-alist (a-list)
-  "Returns a new a-list containing the same associations than `a-list',
-with the shadowed associations removed."
+  "A new a-list with the shadowed associations removed."
   (mapcon (lambda (a-list)
              (if (member* (caar a-list) (cdr a-list) :key (function car) :test (function equal))
                  '()
                  (list (car a-list))))
           (reverse a-list)))

-
 (defun alist->plist (alist)
   "Converts an a-list into a p-list.
 Warning: the keys in p-list should be only symbols. p-lists getf and get use eq."
@@ -564,22 +273,9 @@ Warning: the keys in p-list should be only symbols. p-lists getf and get use eq.
   (loop for (k v) on plist by (function cddr) collect (cons k v)))

 (defun clean-plist (plist)
-  "Returns a new p-list containing the same associations than `p-list',
-with the shadowed associations remvoved."
+  "A new p-list with the shadowed associations removed."
   (alist->plist (clean-alist (plist->alist plist))))


-;; (let ((old-alist '((a . 1) (c . 3) (a . 11) (b . 22) (c . 33))))
-;;   (list (clean-alist old-alist)
-;;         old-alist))
-;;
-;; --> (((b . 22) (c . 3) (a . 1))
-;;      ((a . 1) (c . 3) (a . 11) (b . 22) (c . 33)))
-;;
-;; (let ((old-plist '(a 1 c 3 a 11 b 22 c 33)))
-;;   (list (clean-plist old-plist)
-;;         old-plist))
-;; --> ((b 22 c 3 a 1)
-;;      (a 1 c 3 a 11 b 22 c 33))
-
-;;;; pjb-list.el                      --                     --          ;;;;
+(provide 'pjb-list)
+;;;; THE END ;;;;
ViewGit