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

   1 ;;; riece-cache.el --- LRU based cache management
   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., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, 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-cache-make-map (max-length)
  60   "Make riece-cache-map object."
  61   (vector max-length (make-vector (* max-length 2) 0) 0 nil nil))
  62
  63 (defun riece-cache-map-max-length (map)
  64   "Return max-length of MAP."
  65   (aref map 0))
  66
  67 (defun riece-cache-map-hash-obarray (map)
  68   "Return hash-obarray of MAP."
  69   (aref map 1))
  70
  71 (defun riece-cache-map-hash-length (map)
  72   "Return hash-length of MAP."
  73   (aref map 2))
  74
  75 (defun riece-cache-map-set-hash-length (map hash-length)
  76   "Set hash-length of MAP to HASH-LENGTH."
  77   (aset map 2 hash-length))
  78
  79 (defun riece-cache-map-first (map)
  80   "Return first of MAP."
  81   (aref map 3))
  82
  83 (defun riece-cache-map-set-first (map first)
  84   "Set first of MAP to FIRST."
  85   (aset map 3 first))
  86
  87 (defun riece-cache-map-last (map)
  88   "Return last of MAP."
  89   (aref map 4))
  90
  91 (defun riece-cache-map-set-last (map last)
  92   "Set last of MAP to LAST."
  93   (aset map 4 last))
  94
  95 (defalias 'riece-make-cache 'riece-cache-make-map)
  96
  97 (defun riece-cache-contains (map key)
  98   "Return t if MAP contains an entry whose key is KEY."
  99   (intern-soft key (riece-cache-map-hash-obarray map)))
 100
 101 (defun riece-cache-get (map key)
 102   "Return the value associated with KEY in MAP.
 103 If KEY is not associated in MAP, it returns nil."
 104   (let ((node (riece-cache-get-node map key)))
 105     (if node
 106         (riece-cache-node-value node))))
 107
 108 (defun riece-cache-get-node (map key)
 109   "Return a node object associcated with KEY in MAP.
 110 If KEY is not associated in MAP, it returns nil."
 111   (let ((symbol (intern-soft key (riece-cache-map-hash-obarray map)))
 112         previous next last node)
 113     (when symbol
 114       (setq node (symbol-value symbol)
 115             previous (riece-cache-node-previous node)
 116             next (riece-cache-node-next node)
 117             last (riece-cache-map-last map))
 118       (if previous
 119           (riece-cache-node-set-next previous next))
 120       (if next
 121           (riece-cache-node-set-previous next previous))
 122       (riece-cache-node-set-next node nil)
 123       (riece-cache-node-set-previous node last)
 124       (riece-cache-node-set-next last node)
 125       (riece-cache-map-set-last map node)
 126       (if (and (eq node (riece-cache-map-first map)) next)
 127           (riece-cache-map-set-first map next))
 128       node)))
 129
 130 (defun riece-cache-delete (map key)
 131   "Remove an entry from MAP whose key is KEY."
 132   (let ((symbol (intern-soft key (riece-cache-map-hash-obarray map)))
 133         previous next node)
 134     (when symbol
 135       (setq node (symbol-value symbol)
 136             previous (riece-cache-node-previous node)
 137             next (riece-cache-node-next node))
 138       (if previous
 139           (riece-cache-node-set-next previous next))
 140       (if next
 141           (riece-cache-node-set-previous next previous))
 142       (if (eq (riece-cache-map-last map) node)
 143           (riece-cache-map-set-last map previous))
 144       (if (eq (riece-cache-map-first map) node)
 145           (riece-cache-map-set-first map next))
 146       (unintern symbol (riece-cache-map-hash-obarray map))
 147       (riece-cache-map-set-hash-length map
 148                                        (1- (riece-cache-map-hash-length map)))
 149       (riece-cache-node-value node))))
 150
 151 (defun riece-cache-set (map key value)
 152   "Associate KEY with VALUE in MAP."
 153   (let ((node (riece-cache-get-node map key)))
 154     (if node
 155         (riece-cache-node-set-value node value)
 156       (if (>= (riece-cache-map-hash-length map)
 157               (riece-cache-map-max-length map))
 158           (riece-cache-delete map (riece-cache-node-key
 159                                  (riece-cache-map-first map))))
 160       (setq node (riece-cache-make-node key value (riece-cache-map-last map)))
 161       (set (intern key (riece-cache-map-hash-obarray map)) node)
 162       (riece-cache-map-set-hash-length map
 163                                        (1+ (riece-cache-map-hash-length map)))
 164       (unless (riece-cache-map-first map)
 165         (riece-cache-map-set-first map node))
 166       (when (riece-cache-map-last map)
 167         (riece-cache-node-set-next (riece-cache-map-last map) node)
 168         (riece-cache-node-set-previous node (riece-cache-map-last map)))
 169       (riece-cache-map-set-last map node))))
 170
 171 (provide 'riece-cache)
 172
 173 ;;; riece-cache.el ends here