1 ;;; riece-cache.el --- LRU cache
2 ;; Copyright (C) 1998-2005 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
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)
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.
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.
27 (defun riece-cache-make-node (key value &optional previous next)
28 "Make riece-cache-node object."
29 (vector key value previous next))
31 (defun riece-cache-node-key (node)
35 (defun riece-cache-node-value (node)
36 "Return value of NODE."
39 (defun riece-cache-node-set-value (node value)
40 "Set value of NODE to VALUE."
43 (defun riece-cache-node-next (node)
44 "Return next of NODE."
47 (defun riece-cache-node-set-next (node next)
48 "Set next of NODE to NEXT."
51 (defun riece-cache-node-previous (node)
52 "Return previous of NODE."
55 (defun riece-cache-node-set-previous (node previous)
56 "Set previous of NODE to PREVIOUS."
57 (aset node 2 previous))
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))
63 (defun riece-cache-max-length (cache)
64 "Return max-length of CACHE."
67 (defun riece-cache-hash-obarray (cache)
68 "Return hash-obarray of CACHE."
71 (defun riece-cache-hash-length (cache)
72 "Return hash-length of CACHE."
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))
79 (defun riece-cache-first (cache)
80 "Return first of CACHE."
83 (defun riece-cache-set-first (cache first)
84 "Set first of CACHE to FIRST."
87 (defun riece-cache-last (cache)
88 "Return last of CACHE."
91 (defun riece-cache-set-last (cache last)
92 "Set last of CACHE to LAST."
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)))
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)))
104 (riece-cache-node-value node))))
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)
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))
117 (riece-cache-node-set-next previous 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))
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)))
133 (setq node (symbol-value symbol)
134 previous (riece-cache-node-previous node)
135 next (riece-cache-node-next node))
137 (riece-cache-node-set-next previous 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))))
149 (defun riece-cache-set (cache key value)
150 "Associate KEY with VALUE in CACHE."
151 (let ((node (riece-cache-get-node cache key)))
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))))
169 (provide 'riece-cache)
171 ;;; riece-cache.el ends here