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

   1 (defun riece-lru-make-node (key value &optional previous next)
   2   "Make riece-lru-node object."
   3   (vector key value previous next))
   4
   5 (defun riece-lru-node-key (node)
   6   "Return key of NODE."
   7   (aref node 0))
   8
   9 (defun riece-lru-node-value (node)
  10   "Return value of NODE."
  11   (aref node 1))
  12
  13 (defun riece-lru-node-set-value (node value)
  14   "Set value of NODE to VALUE."
  15   (aset node 1 value))
  16
  17 (defun riece-lru-node-next (node)
  18   "Return next of NODE."
  19   (aref node 3))
  20
  21 (defun riece-lru-node-set-next (node next)
  22   "Set next of NODE to NEXT."
  23   (aset node 3 next))
  24
  25 (defun riece-lru-node-previous (node)
  26   "Return previous of NODE."
  27   (aref node 2))
  28
  29 (defun riece-lru-node-set-previous (node previous)
  30   "Set previous of NODE to PREVIOUS."
  31   (aset node 2 previous))
  32
  33 (defun riece-lru-make-map (max-length)
  34   "Make riece-lru-map object."
  35   (vector max-length (make-vector (* max-length 2) 0) 0 nil nil))
  36
  37 (defun riece-lru-map-max-length (map)
  38   "Return max-length of MAP."
  39   (aref map 0))
  40
  41 (defun riece-lru-map-hash-obarray (map)
  42   "Return hash-obarray of MAP."
  43   (aref map 1))
  44
  45 (defun riece-lru-map-hash-length (map)
  46   "Return hash-length of MAP."
  47   (aref map 2))
  48
  49 (defun riece-lru-map-set-hash-length (map hash-length)
  50   "Set hash-length of MAP to HASH-LENGTH."
  51   (aset map 2 hash-length))
  52
  53 (defun riece-lru-map-first (map)
  54   "Return first of MAP."
  55   (aref map 3))
  56
  57 (defun riece-lru-map-set-first (map first)
  58   "Set first of MAP to FIRST."
  59   (aset map 3 first))
  60
  61 (defun riece-lru-map-last (map)
  62   "Return last of MAP."
  63   (aref map 4))
  64
  65 (defun riece-lru-map-set-last (map last)
  66   "Set last of MAP to LAST."
  67   (aset map 4 last))
  68
  69 (defalias 'riece-make-lru 'riece-lru-make-map)
  70
  71 (defun riece-lru-contains (map key)
  72   (intern-soft key (riece-lru-map-hash-obarray map)))
  73
  74 (defun riece-lru-get (map key)
  75   (let ((node (riece-lru-get-node map key)))
  76     (if node
  77         (riece-lru-node-value node))))
  78
  79 (defun riece-lru-get-node (map key)
  80   (let ((symbol (intern-soft key (riece-lru-map-hash-obarray map)))
  81         previous next last node)
  82     (when symbol
  83       (setq node (symbol-value symbol)
  84             previous (riece-lru-node-previous node)
  85             next (riece-lru-node-next node)
  86             last (riece-lru-map-last map))
  87       (if previous
  88           (riece-lru-node-set-next previous next))
  89       (if next
  90           (riece-lru-node-set-previous next previous))
  91       (riece-lru-node-set-next node nil)
  92       (riece-lru-node-set-previous node last)
  93       (riece-lru-node-set-next last node)
  94       (riece-lru-map-set-last map node)
  95       (if (and (eq node (riece-lru-map-first map)) next)
  96           (riece-lru-map-set-first map next))
  97       node)))
  98
  99 (defun riece-lru-delete (map key)
 100   (let ((symbol (intern-soft key (riece-lru-map-hash-obarray map)))
 101         previous next node)
 102     (when symbol
 103       (setq node (symbol-value symbol)
 104             previous (riece-lru-node-previous node)
 105             next (riece-lru-node-next node))
 106       (if previous
 107           (riece-lru-node-set-next previous next))
 108       (if next
 109           (riece-lru-node-set-previous next previous))
 110       (if (eq (riece-lru-map-last map) node)
 111           (riece-lru-map-set-last map previous))
 112       (if (eq (riece-lru-map-first map) node)
 113           (riece-lru-map-set-first map next))
 114       (unintern symbol (riece-lru-map-hash-obarray map))
 115       (riece-lru-map-set-hash-length map (1- (riece-lru-map-hash-length map)))
 116       (riece-lru-node-value node))))
 117
 118 (defun riece-lru-set (map key value)
 119   (let ((node (riece-lru-get-node map key)))
 120     (if node
 121         (riece-lru-node-set-value node value)
 122       (if (>= (riece-lru-map-hash-length map)
 123               (riece-lru-map-max-length map))
 124           (riece-lru-delete map (riece-lru-node-key
 125                                  (riece-lru-map-first map))))
 126       (setq node (riece-lru-make-node key value (riece-lru-map-last map) nil))
 127       (set (intern key (riece-lru-map-hash-obarray map)) node)
 128       (riece-lru-map-set-hash-length map (1+ (riece-lru-map-hash-length map)))
 129       (unless (riece-lru-map-first map)
 130         (riece-lru-map-set-first map node))
 131       (if (riece-lru-map-last map)
 132           (progn
 133             (riece-lru-node-set-next (riece-lru-map-last map) node)
 134             (riece-lru-node-set-previous node (riece-lru-map-last map))))
 135       (riece-lru-map-set-last map node))))
 136
 137 (provide 'riece-lru)