cgit.sxemacs.org Git - riece/blob - lisp/riece-cache.el

   1 ;;; riece-cache.el --- LRU cache
   2 ;; Copyright (C) 1998-2005 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Code:
  26
  27 (defun riece-cache-make-node (key value &optional previous next)
  28   "Make riece-cache-node object."
  29   (vector key value previous next))
  30
  31 (defun riece-cache-node-key (node)
  32   "Return key of NODE."
  33   (aref node 0))
  34
  35 (defun riece-cache-node-value (node)
  36   "Return value of NODE."
  37   (aref node 1))
  38
  39 (defun riece-cache-node-set-value (node value)
  40   "Set value of NODE to VALUE."
  41   (aset node 1 value))
  42
  43 (defun riece-cache-node-next (node)
  44   "Return next of NODE."
  45   (aref node 3))
  46
  47 (defun riece-cache-node-set-next (node next)
  48   "Set next of NODE to NEXT."
  49   (aset node 3 next))
  50
  51 (defun riece-cache-node-previous (node)
  52   "Return previous of NODE."
  53   (aref node 2))
  54
  55 (defun riece-cache-node-set-previous (node previous)
  56   "Set previous of NODE to PREVIOUS."
  57   (aset node 2 previous))
  58
  59 (defun riece-make-cache (max-length)
  60   "Make riece-cache object."
  61   (vector max-length (make-vector (* max-length 2) 0) 0 nil nil))
  62
  63 (defun riece-cache-max-length (cache)
  64   "Return max-length of CACHE."
  65   (aref cache 0))
  66
  67 (defun riece-cache-hash-obarray (cache)
  68   "Return hash-obarray of CACHE."
  69   (aref cache 1))
  70
  71 (defun riece-cache-hash-length (cache)
  72   "Return hash-length of CACHE."
  73   (aref cache 2))
  74
  75 (defun riece-cache-set-hash-length (cache hash-length)
  76   "Set hash-length of CACHE to HASH-LENGTH."
  77   (aset cache 2 hash-length))
  78
  79 (defun riece-cache-first (cache)
  80   "Return first of CACHE."
  81   (aref cache 3))
  82
  83 (defun riece-cache-set-first (cache first)
  84   "Set first of CACHE to FIRST."
  85   (aset cache 3 first))
  86
  87 (defun riece-cache-last (cache)
  88   "Return last of CACHE."
  89   (aref cache 4))
  90
  91 (defun riece-cache-set-last (cache last)
  92   "Set last of CACHE to LAST."
  93   (aset cache 4 last))
  94
  95 (defun riece-cache-contains (cache key)
  96   "Return t if CACHE contains an entry whose key is KEY."
  97   (intern-soft key (riece-cache-hash-obarray cache)))
  98
  99 (defun riece-cache-get (cache key)
 100   "Return the value associated with KEY in CACHE.
 101 If KEY is not associated in CACHE, it returns nil."
 102   (let ((node (riece-cache-get-node cache key)))
 103     (if node
 104         (riece-cache-node-value node))))
 105
 106 (defun riece-cache-get-node (cache key)
 107   "Return a node object associcated with KEY in CACHE.
 108 If KEY is not associated in CACHE, it returns nil."
 109   (let ((symbol (intern-soft key (riece-cache-hash-obarray cache)))
 110         previous next last node)
 111     (when symbol
 112       (setq node (symbol-value symbol)
 113             previous (riece-cache-node-previous node)
 114             next (riece-cache-node-next node)
 115             last (riece-cache-last cache))
 116       (if previous
 117           (riece-cache-node-set-next previous next))
 118       (if next
 119           (riece-cache-node-set-previous next previous))
 120       (riece-cache-node-set-next node nil)
 121       (riece-cache-node-set-previous node last)
 122       (riece-cache-node-set-next last node)
 123       (riece-cache-set-last cache node)
 124       (if (and (eq node (riece-cache-first cache)) next)
 125           (riece-cache-set-first cache next))
 126       node)))
 127
 128 (defun riece-cache-delete (cache key)
 129   "Remove an entry from CACHE whose key is KEY."
 130   (let ((symbol (intern-soft key (riece-cache-hash-obarray cache)))
 131         previous next node)
 132     (when symbol
 133       (setq node (symbol-value symbol)
 134             previous (riece-cache-node-previous node)
 135             next (riece-cache-node-next node))
 136       (if previous
 137           (riece-cache-node-set-next previous next))
 138       (if next
 139           (riece-cache-node-set-previous next previous))
 140       (if (eq (riece-cache-last cache) node)
 141           (riece-cache-set-last cache previous))
 142       (if (eq (riece-cache-first cache) node)
 143           (riece-cache-set-first cache next))
 144       (unintern symbol (riece-cache-hash-obarray cache))
 145       (riece-cache-set-hash-length cache
 146                                    (1- (riece-cache-hash-length cache)))
 147       (riece-cache-node-value node))))
 148
 149 (defun riece-cache-set (cache key value)
 150   "Associate KEY with VALUE in CACHE."
 151   (let ((node (riece-cache-get-node cache key)))
 152     (if node
 153         (riece-cache-node-set-value node value)
 154       (if (>= (riece-cache-hash-length cache)
 155               (riece-cache-max-length cache))
 156           (riece-cache-delete cache (riece-cache-node-key
 157                                      (riece-cache-first cache))))
 158       (setq node (riece-cache-make-node key value (riece-cache-last cache)))
 159       (set (intern key (riece-cache-hash-obarray cache)) node)
 160       (riece-cache-set-hash-length cache
 161                                    (1+ (riece-cache-hash-length cache)))
 162       (unless (riece-cache-first cache)
 163         (riece-cache-set-first cache node))
 164       (when (riece-cache-last cache)
 165         (riece-cache-node-set-next (riece-cache-last cache) node)
 166         (riece-cache-node-set-previous node (riece-cache-last cache)))
 167       (riece-cache-set-last cache node))))
 168
 169 (provide 'riece-cache)
 170
 171 ;;; riece-cache.el ends here