-
Notifications
You must be signed in to change notification settings - Fork 29
/
skip-list-cursors.lisp
122 lines (106 loc) · 4.18 KB
/
skip-list-cursors.lisp
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
(in-package :graph-db)
(defclass skip-list-cursor (cursor)
((node :initarg :node :accessor skip-list-cursor-node)
(skip-list :initarg :skip-list :accessor skip-list)))
(defmethod cursor-next ((slc skip-list-cursor) &optional eoc)
(with-slots (node) slc
(if node
(if (funcall (%sl-key-equal (skip-list slc))
(%sn-key node)
(%sn-key (%sl-tail (skip-list slc))))
eoc
(let ((result node))
(setq node (node-forward (skip-list slc) node))
result))
eoc)))
(defclass skip-list-value-cursor (skip-list-cursor)
())
(defmethod cursor-next :around ((slc skip-list-value-cursor) &optional eoc)
(let ((result (call-next-method)))
(if (eql result eoc)
eoc
(%sn-value result))))
(defclass skip-list-key-cursor (skip-list-cursor)
())
(defmethod cursor-next :around ((slc skip-list-key-cursor) &optional eoc)
(let ((result (call-next-method)))
(if (eql result eoc)
eoc
(%sn-key result))))
(defmethod make-cursor ((sl skip-list) &key cursor
(cursor-class 'skip-list-cursor)
&allow-other-keys)
(if cursor
(progn (setf (skip-list-cursor-node cursor)
(node-forward sl (%sl-head sl)))
cursor)
(make-instance cursor-class
:skip-list sl
:node (node-forward sl (%sl-head sl)))))
(defmethod make-values-cursor ((sl skip-list) &key &allow-other-keys)
(make-cursor sl :cursor-class 'skip-list-value-cursor))
(defmethod make-keys-cursor ((sl skip-list) &key &allow-other-keys)
(make-cursor sl :cursor-class 'skip-list-key-cursor))
(defclass skip-list-range-cursor (skip-list-cursor)
((end :initarg :end :reader slrc-end)))
(defmethod cursor-next :around ((slc skip-list-range-cursor) &optional eoc)
(with-slots (node end) slc
(if (and node
(or (funcall (%sl-comparison (skip-list slc)) (%sn-key node) end)
(funcall (%sl-key-equal (skip-list slc)) (%sn-key node) end)))
(call-next-method)
eoc)))
(defmethod make-range-cursor ((sl skip-list) start end &key &allow-other-keys)
(let ((preds (make-array (%sl-max-level sl)))
(succs (make-array (%sl-max-level sl))))
(multiple-value-bind (node level-found preds succs)
(find-in-skip-list sl start preds succs)
(declare (ignore level-found preds))
(cond (node
(make-instance 'skip-list-range-cursor
:node node :end end :skip-list sl))
; (preds
; (make-instance 'skip-list-range-cursor
; :node (aref preds 0)
; :end end :skip-list sl))
(succs
(make-instance 'skip-list-range-cursor
:node (aref succs 0)
:end end :skip-list sl))))))
(defmethod map-skip-list (fn (sl skip-list) &key collect-p)
(let ((cursor (make-cursor sl)) (result nil))
(do ((node (cursor-next cursor)
(cursor-next cursor)))
((null node))
(if collect-p
(push (funcall fn node) result)
(funcall fn node)))
(when collect-p
(nreverse result))))
(defmethod map-skip-list-keys (fn (sl skip-list) &key collect-p)
(let ((cursor (make-cursor sl)) (result nil))
(do ((node (cursor-next cursor)
(cursor-next cursor)))
((null node))
(if collect-p
(push (funcall fn (%sn-key node)) result)
(funcall fn (%sn-key node))))
(when collect-p
(nreverse result))))
(defmethod map-skip-list-values (fn (sl skip-list))
(let ((cursor (make-values-cursor sl)))
(do ((val (cursor-next cursor)
(cursor-next cursor)))
((null val))
(funcall fn val))))
(defmethod skip-list-fetch-all ((sl skip-list) key)
"Return all values for a key in a skip list where duplicates are allowed."
(let ((cursor (make-range-cursor sl key key))
(result nil))
(if cursor
(progn
(do ((node (cursor-next cursor) (cursor-next cursor)))
((null node))
(push (second node) result))
(nreverse result))
nil)))