home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / elib-0.06 / library / queue-m.el < prev    next >
Encoding:
Text File  |  1993-01-24  |  3.7 KB  |  133 lines
  1. ;;;; $Id: queue-m.el,v 0.5 1992/08/19 01:57:49 ceder Exp $
  2. ;;;; This file implements a simple FIFO queue using macros.
  3. ;;;;
  4. ;;;; Copyright (C) 1991, 1992 Free Software Foundation
  5. ;;;;
  6. ;;;; This file is part of the GNU Emacs lisp library, Elib.
  7. ;;;;
  8. ;;;; GNU Elib is free software; you can redistribute it and/or modify
  9. ;;;; it under the terms of the GNU General Public License as published by
  10. ;;;; the Free Software Foundation; either version 1, or (at your option)
  11. ;;;; any later version.
  12. ;;;;
  13. ;;;; GNU Elib is distributed in the hope that it will be useful,
  14. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;;;; GNU General Public License for more details.
  17. ;;;;
  18. ;;;; You should have received a copy of the GNU General Public License
  19. ;;;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21. ;;;; 
  22. ;;;; Author: Inge Wallin
  23. ;;;; 
  24.  
  25. ;;;
  26. ;;; The queue is implemented as a two cons cell list, the first 
  27. ;;; containing the tag 'QUEUE.  The car of the the second cons
  28. ;;; cell points at the first element of the queue and the cdr points
  29. ;;; at the last.  All entries and removals are done using destructive
  30. ;;; functions.
  31. ;;;
  32. ;;; This file implements the short functions as macros for speed in 
  33. ;;; compiled code.
  34. ;;;
  35.  
  36.  
  37. ;; Provide the function version and remove the macro version
  38. (provide 'queue-m)
  39. (setq features (delq 'queue-f features))
  40.  
  41.  
  42. ;;; ================================================================
  43.  
  44.  
  45. (defmacro queue-create ()
  46.   "Create an empty fifo queue."
  47.   (` (cons 'QUEUE (cons nil nil))))
  48.  
  49.  
  50. (defmacro queue-p (queue)
  51.   "Return t if QUEUE is a queue, otherwise return nil."
  52.   (` (eq (car-safe (, queue)) 'QUEUE)))
  53.  
  54.  
  55. (defun queue-enqueue (queue element)
  56.   "Enter an element into a queue.
  57. Args: QUEUE ELEMENT"
  58.   (let ((elementcell (cons element nil)))
  59.     (if (null (car (cdr queue)))
  60.     ;; QUEUE is empty
  61.     (setcar (cdr queue)
  62.         (setcdr (cdr queue) 
  63.             elementcell))
  64.       (setcdr (cdr (cdr queue))
  65.           elementcell)
  66.       (setcdr (cdr queue)
  67.           elementcell))))
  68.  
  69.  
  70. (defun queue-dequeue (queue)
  71.   "Remove the first element of QUEUE and return it.
  72. If QUEUE is empty, return nil and do nothing."
  73.   (if (not (null (car (cdr queue))))
  74.       (prog1
  75.       (car (car (cdr queue)))
  76.     (setcar (cdr queue)
  77.         (cdr (car (cdr queue))))
  78.     (if (null (car (cdr queue)))
  79.         (setcdr (cdr queue) nil)))))
  80.  
  81.  
  82. (defmacro queue-empty (queue)
  83.   "Return t if QUEUE is empty, otherwise return nil."
  84.   (` (null (car (cdr (, queue))))))
  85.  
  86.  
  87. (defmacro queue-first (queue)
  88.   "Return the first element of QUEUE or nil if it is empty.
  89. The element is not removed."
  90.   (` (car-safe (car (cdr (, queue))))))
  91.  
  92.  
  93. (defmacro queue-nth (queue n)
  94.   "Return the nth element of a queue, but don't remove it.
  95. Args: QUEUE N
  96. If the length of the queue is less than N, return nil.
  97.  
  98. The oldest element (the first one) has number 0."
  99.   (` (nth (, n) (car (cdr (, queue))))))
  100.  
  101.  
  102. (defmacro queue-last (queue)
  103.   "Return the last element of QUEUE or nil if it is empty."
  104.   (` (car-safe (cdr (cdr (, queue))))))
  105.  
  106.  
  107. (defmacro queue-all (queue)
  108.   "Return a list of all elements of QUEUE or nil if it is empty.
  109. The oldest element in the queue is the first in the list."
  110.   (` (car (cdr (, queue)))))
  111.  
  112.  
  113. (defun queue-copy (queue)
  114.   "Return a copy of QUEUE.  All entries in QUEUE are also copied."
  115.   (let* ((first  (copy-sequence (car (cdr queue))))
  116.      (last first))
  117.     (while (cdr last)
  118.       (setq last (cdr last)))
  119.     (cons 'QUEUE (cons first last))))
  120.  
  121.  
  122. (defmacro queue-length (queue)
  123.   "Return the number of elements in QUEUE."
  124.   (` (length (car (cdr (, queue))))))
  125.  
  126.  
  127. (defmacro queue-clear (queue)
  128.   "Remove all elements from QUEUE."
  129.   (` (setcdr (, queue) (cons nil nil))))
  130.  
  131.  
  132.  
  133.