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   (intern-soft key (riece-cache-map-hash-obarray map)))
  99
 100 (defun riece-cache-get (map key)
 101   (let ((node (riece-cache-get-node map key)))
 102     (if node
 103         (riece-cache-node-value node))))
 104
 105 (defun riece-cache-get-node (map key)
 106   (let ((symbol (intern-soft key (riece-cache-map-hash-obarray map)))
 107         previous next last node)
 108     (when symbol
 109       (setq node (symbol-value symbol)
 110             previous (riece-cache-node-previous node)
 111             next (riece-cache-node-next node)
 112             last (riece-cache-map-last map))
 113       (if previous
 114           (riece-cache-node-set-next previous next))
 115       (if next
 116           (riece-cache-node-set-previous next previous))
 117       (riece-cache-node-set-next node nil)
 118       (riece-cache-node-set-previous node last)
 119       (riece-cache-node-set-next last node)
 120       (riece-cache-map-set-last map node)
 121       (if (and (eq node (riece-cache-map-first map)) next)
 122           (riece-cache-map-set-first map next))
 123       node)))
 124
 125 (defun riece-cache-delete (map key)
 126   (let ((symbol (intern-soft key (riece-cache-map-hash-obarray map)))
 127         previous next node)
 128     (when symbol
 129       (setq node (symbol-value symbol)
 130             previous (riece-cache-node-previous node)
 131             next (riece-cache-node-next node))
 132       (if previous
 133           (riece-cache-node-set-next previous next))
 134       (if next
 135           (riece-cache-node-set-previous next previous))
 136       (if (eq (riece-cache-map-last map) node)
 137           (riece-cache-map-set-last map previous))
 138       (if (eq (riece-cache-map-first map) node)
 139           (riece-cache-map-set-first map next))
 140       (unintern symbol (riece-cache-map-hash-obarray map))
 141       (riece-cache-map-set-hash-length map
 142                                        (1- (riece-cache-map-hash-length map)))
 143       (riece-cache-node-value node))))
 144
 145 (defun riece-cache-set (map key value)
 146   (let ((node (riece-cache-get-node map key)))
 147     (if node
 148         (riece-cache-node-set-value node value)
 149       (if (>= (riece-cache-map-hash-length map)
 150               (riece-cache-map-max-length map))
 151           (riece-cache-delete map (riece-cache-node-key
 152                                  (riece-cache-map-first map))))
 153       (setq node (riece-cache-make-node key value (riece-cache-map-last map)))
 154       (set (intern key (riece-cache-map-hash-obarray map)) node)
 155       (riece-cache-map-set-hash-length map
 156                                        (1+ (riece-cache-map-hash-length map)))
 157       (unless (riece-cache-map-first map)
 158         (riece-cache-map-set-first map node))
 159       (if (riece-cache-map-last map)
 160           (progn
 161             (riece-cache-node-set-next (riece-cache-map-last map) node)
 162             (riece-cache-node-set-previous node (riece-cache-map-last map))))
 163       (riece-cache-map-set-last map node))))
 164
 165 (provide 'riece-cache)
 166
 167 ;;; riece-cache.el ends here