data-objects/memory-btrees-clos.lisp at master · dbmcclain/data-objects · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
;; memory-btrees.lisp -- In-memory B-Trees
;; --------------------------------------------------------------------------------------
;;
;; Copyright (C) 2008 by SpectroDynamics, LLC. All rights reserved.
;;
;; DM/SD  08/08
;; --------------------------------------------------------------------------------------

(in-package :memory-btrees)

;; -------------------------------------------
;; -------------------------------------------
;; Node class for in-memory B-Trees
;;
;; Nodes must have a capacity that is an odd integer. And they must be prepared
;; to hold that many elements, plus 2 additional cells to handle the intermediate needs
;; of add/update-item.

(defclass node (btree:node)
  ((height            :reader   btree:node-height
                      :initarg  :height
                      :initform 1)
   (fill-pointer      :accessor btree:node-fill-pointer
                      :initform 0)
   (node-list         :reader   node-list
                      :initform (make-array 103)
                      :initarg  :node-list)
   ))

;; -----------------------------------

(defmethod btree:node-list-cell ((node node) index)
  (svref (node-list node) index))

(defmethod (setf btree:node-list-cell) (val (node node) index)
  (setf (svref (node-list node) index) val))

;; -----------------------------

(defmethod btree:copy-node-list-cells ((to node) to-index
                                       (from node) from-index
                                       ncells)
  (setf (subseq (node-list to) to-index (+ to-index ncells))
        (subseq (node-list from) from-index (+ from-index ncells))))

;; ------------------------------------------------------------

(defmethod btree:node-capacity ((node node))
  (- (length (node-list node)) 2))

;; -------------------------------------------
;; -------------------------------------------
;; BTree class -- an in-memory version of B-Trees.
;; BTree classes are required to have methods:
;;
;;   btree:root-node,   (setf btree:root-node)
;;   btree:items-count, (setf btree:items-count)
;;   btree:compare-fn,
;;   btree:key-fn
;;   btree:make-node,
;;   btree:discard-node

(defclass btree (btree:btree)
  ((root-node   :accessor btree:root-node
                :initform nil)

   (items-count :accessor btree:items-count
                :initform 0)

   (node-size   :reader   node-size
                :initarg  :node-size
                :initform 101)

   (btree-lock  :reader   btree:btree-lock
                :initform (mpcompat:make-lock :name "BTree"))

   ))

(defun make-btree (&key (compare '-) (key 'identity) (node-size 101))
  (let ((node-size (logior 1 node-size))) ;; ensure size is oddp
    (make-instance 'btree
                   :compare    compare
                   :key        key
                   :node-size  node-size)))

(defmethod btree:make-node ((btree btree) height)
  (make-instance 'node
                 :height    height
                 :node-list (make-array (+ 2 (node-size btree)))
                 ))

(defmethod btree:discard-node ((btree btree) (node node))
  ;; nothing to do here...
  t)

(defmethod btree:coerce-to-object ((btree btree) obj)
  obj)

;; ---------------------------------------------------------

(defmethod btree:get-cache ((btree btree) constructor-fn)
  (declare (ignore constructor-fn))
  nil)

;; --------------------------------------