1 /*** skiplist.c -- Pugh's Skiplists
3 * Copyright (C) 2006, 2007, 2008 Sebastian Freundt
5 * Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 * This file is part of SXEmacs.
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted provided that the following conditions
13 * 1. Redistributions of source code must retain the above copyright
14 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
20 * 3. Neither the name of the author nor the names of any contributors
21 * may be used to endorse or promote products derived from this
22 * software without specific prior written permission.
24 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
28 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
31 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
33 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
34 * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
38 /* Synched up with: Not in FSF. */
51 #define __SKIPLIST_DEBUG__(args...) fprintf(stderr, "SKIPLIST " args)
52 #ifndef SKIPLIST_DEBUG_FLAG
53 #define SL_DEBUG(args...)
55 #define SL_DEBUG(args...) __SKIPLIST_DEBUG__(args)
57 #define SL_CRITICAL(args...) __SKIPLIST_DEBUG__("CRITICAL: " args)
58 #define SL_DEBUG_LEVEL(args...) SL_DEBUG("[level]: " args)
59 #define SL_DEBUG_NODE(args...) SL_DEBUG("[node]: " args)
60 #define SL_DEBUG_DATA(args...) SL_DEBUG("[data]: " args)
61 #define SL_DEBUG_PATH(args...) SL_DEBUG("[path]: " args)
63 #define ALIGNED(n) __attribute__((aligned(n), packed))
65 Lisp_Object Qskiplistp;
68 struct skiplist_data_s {
74 struct skiplist_level_s {
75 skiplist_level_t nextnode; /* pointer to neighbour node */
76 skiplist_level_t nextlevel; /* pointer to above level */
77 skiplist_node_t node; /* parent */
80 struct skiplist_node_s {
81 skiplist_level_t head; /* pointer to first level */
82 skiplist_level_t foot; /* pointer to lowest level */
83 size_t nlevels; /* number of levels in this node */
85 struct skiplist_data_s data; /* pointer to node's data cell */
88 /* paths stuff, just internal */
89 #define skiplist_path_nil (skiplist_level_t)NULL
93 skiplist_size(const skiplist_t sl)
94 __attribute__((always_inline));
96 skiplist_size(const skiplist_t sl)
98 /* what a fooking name, no? */
99 return (size_t)skiplist_nnodes(sl);
102 /* static bindings */
103 /* low level bindings */
104 static skiplist_level_t make_skiplist_levels(skiplist_node_t, size_t);
107 skiplist_find_key_path(skiplist_t, Lisp_Object, skiplist_level_t[])
108 __attribute__((always_inline));
110 skiplist_find_hash_path(skiplist_t, hcode_t, skiplist_level_t[])
111 __attribute__((always_inline));
112 static inline skiplist_level_t
113 skiplist_find_hash_return_level(skiplist_t, hcode_t)
114 __attribute__((always_inline));
116 extern int get_random(void);
118 /* high level bindings */
120 /* low level bindings */
121 #define node_head_level(node) (node)->head
122 #define node_foot_level(node) (node)->foot
123 #define node_data(node) (node)->data
124 #define node_nlevels(node) (node)->nlevels
125 #define node_data_hash(node) (node)->data.hash
126 #define node_data_key(node) (node)->data.key
127 #define node_data_value(node) (node)->data.value
129 #define next_node(level) (level)->nextnode
130 #define next_level(level) (level)->nextlevel
131 #define parent_node(level) (level)->node
133 #define next_hash(level) node_data_hash(parent_node(next_node(level)))
134 #define next_key(level) node_data_key(parent_node(next_node(level)))
135 #define next_value(level) node_data_value(parent_node(next_node(level)))
137 #define level_hash(l) \
138 (l ? (l->node) ? (l->node->data.hash) : 0 : 0)
139 #define level_key(l) \
140 (l ? (l->node) ? (l->node->data.key) : 0 : 0)
142 /* static hcode_t skiplist_hash(Lisp_Object); */
143 #define skiplist_hash(obj) internal_hash((obj), 0)
144 #define skiplist_keyeq(o1, o2) internal_equal((o1), (o2), 0)
146 /* this is p^n - 1 */
148 #define SL_PROBABILITY_MASK 3
151 static inline skiplist_level_t
152 make_skiplist_levels(skiplist_node_t node, size_t nlevels)
153 __attribute__((always_inline));
154 static inline skiplist_level_t
155 make_skiplist_levels(skiplist_node_t node, size_t nlevels)
157 /* creates an array of NLEVEL levels and returns a pointer */
158 skiplist_level_t levels =
159 xnew_array(struct skiplist_level_s, nlevels+1);
161 /* initialise the parent, it's at least one level we hope */
162 parent_node(levels) = node;
163 next_level(levels) = NULL;
164 next_node(levels) = NULL;
165 while (nlevels > 0) {
166 levels[nlevels].node = node;
167 levels[nlevels].nextnode = NULL;
168 levels[nlevels].nextlevel = &levels[nlevels-1];
175 __fill_skiplist_node(skiplist_node_t n, hcode_t h,
176 Lisp_Object key, Lisp_Object value)
177 __attribute__((always_inline));
179 __fill_skiplist_node(skiplist_node_t n, hcode_t h,
180 Lisp_Object key, Lisp_Object value)
182 /* initialise an empty node */
183 node_data_hash(n) = h;
184 node_data_key(n) = key;
185 node_data_value(n) = value;
189 static inline skiplist_node_t
190 _make_skiplist_node(hcode_t h, Lisp_Object key, Lisp_Object val, size_t nl)
191 __attribute__((always_inline));
192 static inline skiplist_node_t
193 _make_skiplist_node(hcode_t h, Lisp_Object key, Lisp_Object val, size_t nl)
195 skiplist_node_t node = xnew_and_zero(struct skiplist_node_s);
196 skiplist_level_t levs = make_skiplist_levels(node, nl);
198 /* fill in the values */
199 __fill_skiplist_node(node, h, key, val);
203 node->head = &(levs[nl]);
207 static inline skiplist_node_t
208 make_skiplist_node(Lisp_Object key, Lisp_Object value, size_t nlevels)
209 __attribute__((always_inline));
210 static inline skiplist_node_t
211 make_skiplist_node(Lisp_Object key, Lisp_Object value, size_t nlevels)
213 return _make_skiplist_node(skiplist_hash(key), key, value, nlevels);
216 static inline skiplist_level_t
217 raise_head_level(skiplist_t sl)
219 skiplist_nlevels(sl)++;
220 return skiplist_head(sl);
223 static inline skiplist_level_t
224 lower_head_level(skiplist_t sl)
226 if (skiplist_nlevels(sl)-- > 0) {
227 skiplist_nlevels(sl) = 0;
229 return skiplist_head(sl);
233 reconcile_levelling(skiplist_t sl)
235 for (; skiplist_nlevels(sl) > 0; skiplist_nlevels(sl)--) {
236 if (next_node(skiplist_head(sl)) != NULL) {
244 free_skiplist_levels(skiplist_level_t level_array)
245 __attribute__((always_inline));
247 free_skiplist_levels(skiplist_level_t level_array)
254 free_skiplist_node(skiplist_node_t node)
255 __attribute__((always_inline));
257 free_skiplist_node(skiplist_node_t node)
259 /* free the level array */
260 SL_DEBUG_LEVEL("freeing level array 0x%p", node->foot);
261 #if defined LET_GCC_BUGS_BITE_US
262 /* must be the inline code plus write-combining :( */
263 free_skiplist_levels(node->foot);
273 add_level_neighbour(skiplist_level_t level, skiplist_level_t neighbour)
274 __attribute__((always_inline));
276 add_level_neighbour(skiplist_level_t level, skiplist_level_t neighbour)
278 next_node(neighbour) = next_node(level);
279 next_node(level) = neighbour;
283 /* higher level bindings */
285 skiplist_find_key_path(skiplist_t slist, Lisp_Object key, skiplist_level_t p[])
287 return skiplist_find_hash_path(slist, skiplist_hash(key), p);
290 static inline skiplist_level_t
291 skiplist_find_level(skiplist_t slist, Lisp_Object key)
293 return skiplist_find_hash_return_level(slist, skiplist_hash(key));
296 static inline skiplist_level_t
297 pop_node_level(skiplist_node_t node)
299 skiplist_level_t tmp;
305 node->head = tmp->nextlevel;
306 tmp->nextlevel = NULL; /* does not make sense for isolated levels */
309 if (node->head == NULL) {
313 SL_DEBUG_LEVEL("popped level 0x%lx\n", (long unsigned int)tmp);
318 skiplist_find_hash_path(skiplist_t slist, hcode_t hash, skiplist_level_t p[])
320 skiplist_level_t tmp = NULL;
322 /* result is the index of the last element */
325 if (!(tmp = skiplist_head(slist))) {
330 p[result] = tmp; /* just push the skiplist head */
331 for (; tmp; tmp = next_level(tmp)) {
332 for (; next_node(tmp) &&
333 (tmphash = next_hash(tmp)) &&
335 tmp = next_node(tmp)) { }
341 static inline skiplist_level_t
342 skiplist_find_hash_return_level(skiplist_t slist, hcode_t hash)
344 skiplist_level_t result, tmp;
347 if (UNLIKELY((result = tmp = skiplist_head(slist)) == NULL)) {
351 for (; tmp; tmp = next_level(tmp)) {
352 for (; next_node(tmp) &&
353 (tmphash = next_hash(tmp)) &&
355 tmp = next_node(tmp) ) {}
362 /* debugging only ... what's the global #define for it? */
363 #ifdef SKIPLIST_DEBUG_FLAG
365 list_skiplist(skiplist_t sl)
367 skiplist_level_t head, tmp;
369 __SKIPLIST_DEBUG__("*** SXEmacs: internal skiplist structure\n");
370 head = skiplist_head(sl);
374 __SKIPLIST_DEBUG__("%lu->", level_hash(tmp));
375 tmp = next_node(tmp);
377 __SKIPLIST_DEBUG__("0\n");
378 head = next_level(head);
383 DEFUN("list-skiplist", Flist_skiplist, 1, 1, 0, /*
388 list_skiplist(XSKIPLIST(skiplist));
397 mark_skiplist(Lisp_Object obj)
399 /* traverse the skiplist, we simply use the lowest level since
400 * that should be a single-linked list */
401 for (skiplist_level_t tmp = next_node(XSKIPLIST_FOOT(obj));
402 tmp; tmp = next_node(tmp)) {
403 mark_object(node_data_key(parent_node(tmp)));
404 mark_object(node_data_value(parent_node(tmp)));
407 mark_object(XSKIPLIST_PLIST(obj));
408 return XSKIPLIST_PLIST(obj);
412 print_skiplist(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
416 write_c_string("#<skiplist :size ", printcharfun);
417 snprintf(num, 15, "%lu", (long unsigned int)XSKIPLIST_NNODES(obj));
418 write_c_string(num, printcharfun);
419 write_c_string(" :levels ", printcharfun);
420 snprintf(num, 15, "%lu", (long unsigned int)XSKIPLIST_NLEVELS(obj));
421 write_c_string(num, printcharfun);
422 write_c_string(">", printcharfun);
426 finalise_skiplist(void *header, int UNUSED(for_disksave))
428 skiplist_t sl = header;
430 SL_DEBUG("*** SXEmacs: skiplist finalisation 0x%lx\n",
431 (long unsigned int)sl);
433 /* traverse the skiplist and free all node and data cells */
434 for (skiplist_level_t tmp = next_node(skiplist_foot(sl)); tmp; ) {
435 volatile skiplist_level_t nex = next_node(tmp);
436 SL_DEBUG_NODE("freeing 0x%lx\n",
437 (long unsigned int)tmp->node);
438 free_skiplist_node(tmp->node);
442 /* free skiplist head levels */
445 /* and finally commit suicide */
450 skiplist_getprop(Lisp_Object obj, Lisp_Object property)
452 return external_plist_get(&XSKIPLIST_PLIST(obj), property, 0, ERROR_ME);
456 skiplist_putprop(Lisp_Object obj, Lisp_Object property, Lisp_Object value)
458 external_plist_put(&XSKIPLIST_PLIST(obj), property, value, 0, ERROR_ME);
463 skiplist_remprop(Lisp_Object obj, Lisp_Object property)
465 return external_remprop(&XSKIPLIST_PLIST(obj), property, 0, ERROR_ME);
468 DEFUN("skiplist-plist", Fskiplist_plist, 1, 1, 0, /*
469 Return the property list of SKIPLIST.
473 CHECK_SKIPLIST(skiplist);
474 return XSKIPLIST_PLIST(skiplist);
477 static const struct lrecord_description skiplist_description[] = {
478 {XD_OPAQUE_PTR, offsetof(struct skiplist_s, headlevs)},
479 {XD_INT, offsetof(struct skiplist_s, nnodes)},
480 {XD_INT, offsetof(struct skiplist_s, nlevels)},
481 {XD_LISP_OBJECT, offsetof(struct skiplist_s, plist)},
485 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS("skiplist", skiplist,
486 mark_skiplist, print_skiplist,
489 skiplist_description,
496 static inline skiplist_t
497 allocate_skiplist(void)
498 __attribute__((always_inline));
499 static inline skiplist_t
500 allocate_skiplist(void)
502 skiplist_t skiplist =
503 alloc_lcrecord_type(struct skiplist_s, &lrecord_skiplist);
510 skiplist_t sl = allocate_skiplist();
513 /* the categories are actually seq and dict, but use the per-type
514 implementation for a start */
515 sl->lheader.lheader.morphisms = (1<<cat_mk_lc);
517 sl->headlevs = make_skiplist_levels(NULL, MAX_SKIPLIST_HEIGHT);
518 skiplist_nnodes(sl) = 0;
519 skiplist_nlevels(sl) = 0; /* means 1 actually */
520 skiplist_plist(sl) = Qnil;
522 XSETSKIPLIST(result, sl);
527 DEFUN("make-skiplist", Fmake_skiplist, 0, 0, 0, /*
528 Return a new empty skiplist object.
532 /* gotta seed our oracle; this is a stupid seed value though */
533 return make_skiplist();
538 DEFUN("skiplistp", Fskiplistp, 1, 1, 0, /*
539 Return non-nil if OBJECT is a skiplist.
543 if (SKIPLISTP(object)) {
550 DEFUN("skiplist-empty-p", Fskiplist_empty_p, 1, 1, 0, /*
551 Return non-nil if SKIPLIST is empty.
555 CHECK_SKIPLIST(skiplist);
557 if (XSKIPLIST_NNODES(skiplist) == 0) {
564 /* modifiers and accessors */
566 _put_skiplist(skiplist_t sl, skiplist_level_t *path, size_t psz,
567 hcode_t h, Lisp_Object key, Lisp_Object value)
569 /* entirely new data, build a node for it */
570 /* determine the number of levels to add */
571 size_t nlevels = __ase_ffsl(random()), cnt;
572 skiplist_level_t levels, last = path[psz--];
573 skiplist_node_t node;
575 node = _make_skiplist_node(h, key, value, nlevels);
580 add_level_neighbour(last, node->foot /* level[0] */);
582 if (LIKELY(nlevels <= psz)) {
587 for (size_t i = 1; i <= cnt; i++) {
588 skiplist_level_t level = &levels[i];
590 SL_DEBUG_LEVEL("created level 0x%lx\n",
591 (long unsigned int)level);
593 last = /* skiplist_path_pop(path) */ path[psz--];
594 SL_DEBUG("last 0x%lx "
596 (long unsigned int)last,
597 (long unsigned int)level);
598 add_level_neighbour(last, level);
600 for (size_t i = cnt+1; i <= nlevels; i++) {
601 skiplist_level_t newhlevel = raise_head_level(sl);
602 skiplist_level_t level = &levels[i];
604 SL_DEBUG("head level 0x%lx "
606 (long unsigned int)newhlevel,
607 (long unsigned int)level);
608 add_level_neighbour(newhlevel, level);
614 put_skiplist(skiplist_t sl, Lisp_Object key, Lisp_Object value)
616 skiplist_level_t last;
617 /* C99 we need you */
618 skiplist_level_t path[skiplist_nlevels(sl)+2];
619 hcode_t hkey = skiplist_hash(key);
623 last = path[lastidx = skiplist_find_hash_path(sl, hkey, path)];
625 if (UNLIKELY(/* skiplist_path_size(path) == 0 */ lastidx == 0 ||
626 /* skiplist_pop(path) == NULL */ last == NULL)) {
630 /* hash this prick */
631 h = skiplist_hash(key);
633 /* now either we have to insert, or replace */
634 /* for that we check if the element right of left is by chance
635 * the thing we look for */
636 if (UNLIKELY(h == level_hash(next_node(last)))) {
637 skiplist_level_t level = next_node(last);
639 if (UNLIKELY(!skiplist_keyeq(key, level_key(level)))) {
640 SL_CRITICAL("*** SXEmacs CRITICAL: "
641 "non trivial skiplist collision :(\n");
644 /* oh, we have to replace, we just nuke the old
645 * data cell and replace it with the new one
647 SL_DEBUG("*** SXEmacs: skiplist collision, replace\n");
648 node_data_key(parent_node(level)) = key;
649 node_data_value(parent_node(level)) = value;
652 _put_skiplist(sl, path, lastidx, h, key, value);
657 DEFUN("put-skiplist", Fput_skiplist, 3, 3, 0, /*
658 Add KEY to the SKIPLIST and assign VALUE.
660 (skiplist, key, value))
662 CHECK_SKIPLIST(skiplist);
664 put_skiplist(XSKIPLIST(skiplist), key, value);
670 get_skiplist(skiplist_t sl, Lisp_Object key, Lisp_Object default_)
672 skiplist_node_t node;
673 skiplist_level_t level;
675 if (UNLIKELY((level = skiplist_find_level(sl, key)) == NULL)) {
679 /* level points to rightmost and footmost level to the left of key */
680 if (next_node(level)) {
681 level = next_node(level);
684 if (!(node = level->node)) {
688 if (!(skiplist_keyeq(node_data_key(node), key))) {
692 return node_data_value(node);
695 DEFUN("get-skiplist", Fget_skiplist, 2, 3, 0, /*
696 Return the value of KEY in SKIPLIST.
697 If KEY is not an element, return `nil' instead or --
698 if specified -- DEFAULT.
700 (skiplist, key, default_))
702 CHECK_SKIPLIST(skiplist);
704 return get_skiplist(XSKIPLIST(skiplist), key, default_);
708 remove_skiplist(skiplist_t sl, Lisp_Object key)
709 /* remove KEY from SKIPLIST (pathless approach) */
711 skiplist_node_t node;
712 skiplist_level_t level, last;
713 /* C99 we need you! */
714 skiplist_level_t path[skiplist_nlevels(sl)+2];
715 hcode_t hkey = skiplist_hash(key);
718 lastidx = skiplist_find_hash_path(sl, hkey, path);
719 last = path[lastidx];
721 if (/* skiplist_path_size(path) == 0 */ lastidx == 0 ||
722 /* skiplist_last(path) == NULL */ path[0] == NULL) {
726 if (hkey == level_hash(next_node(last)) &&
727 skiplist_keyeq(key, level_key(next_node(last)))) {
728 node = parent_node(next_node(last));
730 /* traverse (bottom-up) the level structure
731 * and free any occurring level pointers */
732 while (lastidx > 0 /* because we `popped' the head */ &&
734 /* skiplist_path_pop(path) */
735 path[lastidx--]) != skiplist_path_nil &&
737 parent_node(next_node(last)) == node) {
738 level = next_node(last);
739 next_node(last) = next_node(level);
742 /* free node (kill data cell and levels with it) */
743 free_skiplist_node(node);
744 /* decrement skiplist size */
745 skiplist_nnodes(sl)--;
747 /* now, the skiplist head might have many nil pointers
748 * we reduce the overall levelling in that case */
749 reconcile_levelling(sl);
754 DEFUN("remove-skiplist", Fremove_skiplist, 2, 2, 0, /*
755 Remove the element specified by KEY from SKIPLIST.
756 If KEY is not an element, this is a no-op.
760 CHECK_SKIPLIST(skiplist);
762 remove_skiplist(XSKIPLIST(skiplist), key);
767 /* C99 where are you? */
769 skiplist_owns_p(skiplist_t skiplist, Lisp_Object key)
770 /* return !0 iff SKIPLIST has a node for KEY */
772 skiplist_node_t node;
773 skiplist_level_t level;
774 hcode_t hkey = skiplist_hash(key);
776 level = skiplist_find_hash_return_level(skiplist, hkey);
778 if (level == skiplist_path_nil) {
782 /* level points to rightmost and footmost level to the left of key */
783 if (next_node(level))
784 level = next_node(level);
786 if ((node = level->node) == NULL) {
790 if (!(skiplist_keyeq(node_data_key(node), key))) {
797 DEFUN("skiplist-owns-p", Fskiplist_owns_p, 2, 2, 0, /*
798 Return non-nil if KEY is associated with a value in SKIPLIST.
802 CHECK_SKIPLIST(skiplist);
804 return (skiplist_owns_p(XSKIPLIST(skiplist), key) ? Qt : Qnil);
808 /* informational cruft */
809 DEFUN("skiplist-size", Fskiplist_size, 1, 1, 0, /*
810 Return the size of SKIPLIST, that is the number of elements.
814 CHECK_SKIPLIST(skiplist);
815 return make_int((int32_t)XSKIPLIST_NNODES(skiplist));
820 copy_skiplist(skiplist_t skiplist)
822 Lisp_Object result = make_skiplist();
823 skiplist_t sl_copy = XSKIPLIST(result);
824 skiplist_level_t tmp;
825 Lisp_Object key, val;
827 /* traverse the skiplist */
828 tmp = next_node(skiplist_foot(skiplist));
830 key = node_data_key(parent_node(tmp));
831 val = node_data_value(parent_node(tmp));
832 put_skiplist(sl_copy, key, val);
833 tmp = next_node(tmp);
838 DEFUN("copy-skiplist", Fcopy_skiplist, 1, 1, 0, /*
839 Return a copy of skiplist SKIPLIST.
840 The elements of SKIPLIST are not copied; they are shared
846 CHECK_SKIPLIST(skiplist);
848 return copy_skiplist(XSKIPLIST(skiplist));
851 void unite_skiplist(skiplist_t target, skiplist_t source)
853 /* unite target and source and store result in target */
854 Lisp_Object key, value;
855 skiplist_level_t lev;
857 lev = next_node(skiplist_foot(source)); /* start at the bottom */
859 key = node_data_key(parent_node(lev));
860 value = node_data_value(parent_node(lev));
861 put_skiplist(target, key, value);
862 lev = next_node(lev);
866 DEFUN("skiplist-union", Fskiplist_union, 0, MANY, 0, /*
867 Return the union skiplist of SKIPLISTS.
868 Args are &rest SKIPLIST.
870 The union is a skiplist containing all key-value-pairs which are
871 in at least one of the SKIPLISTS.
873 Note: Key-value-pairs with equal keys and distinct values are
874 processed from left to right, that is the final union for such pairs
875 contains the value of the rightmost skiplist in @var{skiplists}.
877 (int nargs, Lisp_Object *args))
882 for (i=0; i<nargs; i++)
883 CHECK_SKIPLIST(args[i]);
885 result = make_skiplist();
886 for (i=0; i<nargs; i++) {
887 unite_skiplist(XSKIPLIST(result), XSKIPLIST(args[i]));
892 void intersect_skiplist(skiplist_t target, skiplist_t source)
894 /* intersect target and source and store result in target */
896 skiplist_level_t lev;
898 lev = next_node(skiplist_foot(target)); /* start at the bottom */
900 key = node_data_key(parent_node(lev));
901 lev = next_node(lev);
902 if (!skiplist_owns_p(source, key)) {
903 remove_skiplist(target, key);
905 lev = next_node(lev);
910 DEFUN("skiplist-intersection", Fskiplist_intersection, 0, MANY, 0, /*
911 Return the intersection skiplist of SKIPLISTS.
912 Args are &rest SKIPLIST.
914 The intersection is a skiplist containing all key-value-pairs
915 which are in all skiplists of SKIPLISTS.
917 Note: Key-value-pairs with equal keys and distinct values are
918 processed from right to left, that is the final intersection for such
919 pairs contains the value of the leftmost skiplist in SKIPLISTS.
921 (int nargs, Lisp_Object *args))
927 return make_skiplist();
929 for (i=0; i<nargs; i++)
930 CHECK_SKIPLIST(args[i]);
932 result = copy_skiplist(XSKIPLIST(args[0]));
933 for (i=1; i<nargs; i++) {
934 intersect_skiplist(XSKIPLIST(result), XSKIPLIST(args[i]));
940 map_skiplist(skiplist_t sl, skiplist_map_f mapf)
942 skiplist_level_t lev;
944 lev = next_node(skiplist_foot(sl)); /* start at the bottom */
947 k = node_data_key(parent_node(lev));
948 v = node_data_value(parent_node(lev));
951 lev = next_node(lev);
957 map2_skiplist(skiplist_t sl, skiplist_map2_f mapf, void *ptr)
959 skiplist_level_t lev;
961 lev = next_node(skiplist_foot(sl)); /* start at the bottom */
964 k = node_data_key(parent_node(lev));
965 v = node_data_value(parent_node(lev));
968 lev = next_node(lev);
973 DEFUN("map-skiplist", Fmap_skiplist, 2, 2, 0, /*
974 Map FUNCTION over entries in SKIPLIST, calling it with two args,
975 each key and value in SKIPLIST.
977 FUNCTION may not modify SKIPLIST, with the one exception that FUNCTION
978 may remove or reput the entry currently being processed by FUNCTION.
980 (function, skiplist))
984 skiplist_level_t lev;
985 struct gcpro gcpro1, gcpro2;
987 CHECK_SKIPLIST(skiplist);
989 GCPRO2(function, skiplist);
990 sl = XSKIPLIST(skiplist);
991 lev = next_node(skiplist_foot(sl)); /* start at the bottom */
994 args[1] = node_data_key(parent_node(lev));
995 args[2] = node_data_value(parent_node(lev));
997 Ffuncall(countof(args), args);
998 lev = next_node(lev);
1007 DEFUN("skiplist-to-alist", Fskiplist_to_alist, 1, 1, 0, /*
1008 Return the ordinary association list induced by SKIPLIST.
1012 Lisp_Object result = Qnil;
1013 skiplist_level_t tmp;
1014 Lisp_Object key, val;
1016 CHECK_SKIPLIST(skiplist);
1018 /* traverse the skiplist */
1019 tmp = next_node(XSKIPLIST_FOOT(skiplist));
1021 key = node_data_key(parent_node(tmp));
1022 val = node_data_value(parent_node(tmp));
1023 result = Fcons(Fcons(key, val), result);
1024 tmp = next_node(tmp);
1030 DEFUN("skiplist-to-plist", Fskiplist_to_plist, 1, 1, 0, /*
1031 Return the ordinary association list induced by SKIPLIST.
1035 Lisp_Object result = Qnil;
1036 skiplist_level_t tmp;
1037 Lisp_Object key, val;
1039 CHECK_SKIPLIST(skiplist);
1041 /* traverse the skiplist */
1042 tmp = next_node(XSKIPLIST_FOOT(skiplist));
1044 key = node_data_key(parent_node(tmp));
1045 val = node_data_value(parent_node(tmp));
1046 result = Fcons(val, result);
1047 result = Fcons(key, result);
1048 tmp = next_node(tmp);
1054 DEFUN("alist-to-skiplist", Falist_to_skiplist, 1, 1, 0, /*
1055 Return a skiplist from ALIST with equal key space and image.
1059 Lisp_Object result = make_skiplist();
1060 skiplist_t sl = XSKIPLIST(result);
1061 Lisp_Object tmp, key, val;
1065 /* traverse the alist */
1067 while (!NILP(tmp)) {
1068 key = XCAR(XCAR(tmp));
1069 val = XCDR(XCAR(tmp));
1071 put_skiplist(sl, key, val);
1079 DEFUN("plist-to-skiplist", Fplist_to_skiplist, 1, 1, 0, /*
1080 Return a skiplist from PLIST with equal key space and image.
1084 Lisp_Object result = make_skiplist();
1085 skiplist_t sl = XSKIPLIST(result);
1086 Lisp_Object tmp, key, val;
1090 /* traverse the plist */
1092 while (!NILP(tmp)) {
1094 val = XCAR(XCDR(tmp));
1096 put_skiplist(sl, key, val);
1098 tmp = Fcdr(Fcdr(tmp));
1105 /* iterator crap, only needed for dict so make it static */
1107 skiplist_iter_init(dict_t d, dict_iter_t di)
1110 /* go to the bottommost level */
1111 di->data = next_node(skiplist_foot((skiplist_t)d));
1116 skiplist_iter_fini(dict_iter_t di)
1118 di->dict = di->data = NULL;
1122 /* the next one is for dicts only */
1124 skiplist_diter_next(dict_iter_t di, Lisp_Object *key, Lisp_Object *val)
1126 skiplist_level_t sll = di->data;
1128 if (LIKELY(sll != NULL)) {
1129 *key = node_data_key(parent_node(sll));
1130 *val = node_data_value(parent_node(sll));
1131 di->data = next_node(sll);
1133 *key = *val = Qnull_pointer;
1138 /* and the one for seqs */
1140 skiplist_siter_next(seq_iter_t di, void **elm)
1142 skiplist_level_t sll = di->data;
1144 if (LIKELY(sll != NULL)) {
1145 *elm = (void*)node_data_key(parent_node(sll));
1146 di->data = next_node(sll);
1148 *elm = Qnull_pointer;
1154 skiplist_iter_reset(seq_iter_t si)
1156 /* go to the bottommost level */
1157 si->data = next_node(skiplist_foot((skiplist_t)si->seq));
1162 skiplist_explode(void *restrict tgt[], size_t ntgt, const seq_t s)
1164 volatile size_t i = 0;
1165 volatile skiplist_level_t n = next_node(skiplist_foot((skiplist_t)s));
1167 while (n != NULL && i < ntgt) {
1168 tgt[i++] = (void*)node_data_key(parent_node(n));
1176 * Initialisation stuff
1178 static struct dict_impl_s __dskiplist = {
1179 .size_f = (dict_size_f)skiplist_size,
1180 .put_f = (dict_put_f)put_skiplist,
1181 .get_f = (dict_get_f)get_skiplist,
1182 .remove_f = (dict_remove_f)remove_skiplist,
1183 .iter_init_f = skiplist_iter_init,
1184 .iter_next_f = skiplist_diter_next,
1185 .iter_fini_f = skiplist_iter_fini,
1188 static struct seq_impl_s __sskiplist = {
1189 .length_f = (seq_length_f)skiplist_size,
1190 .iter_init_f = (seq_iter_init_f)skiplist_iter_init,
1191 .iter_next_f = skiplist_siter_next,
1192 .iter_fini_f = (seq_iter_fini_f)skiplist_iter_fini,
1193 .iter_reset_f = skiplist_iter_reset,
1194 .explode_f = skiplist_explode,
1197 /* deal with dict interface */
1198 const dict_impl_t dict_skiplist = &__dskiplist;
1199 /* deal with the seq interface (actually a set interface) */
1200 const seq_impl_t seq_skiplist = &__sskiplist;
1202 void syms_of_skiplist(void)
1204 INIT_LRECORD_IMPLEMENTATION(skiplist);
1206 defsymbol(&Qskiplistp, "skiplistp");
1208 DEFSUBR(Fmake_skiplist);
1209 DEFSUBR(Fskiplist_plist);
1211 DEFSUBR(Fskiplistp);
1212 DEFSUBR(Fskiplist_empty_p);
1214 DEFSUBR(Fput_skiplist);
1215 DEFSUBR(Fget_skiplist);
1216 DEFSUBR(Fremove_skiplist);
1217 DEFSUBR(Fskiplist_owns_p);
1219 DEFSUBR(Fskiplist_size);
1221 DEFSUBR(Fcopy_skiplist);
1222 DEFSUBR(Fskiplist_union);
1223 DEFSUBR(Fskiplist_intersection);
1224 DEFSUBR(Fmap_skiplist);
1226 #ifdef SKIPLIST_DEBUG_FLAG
1227 DEFSUBR(Flist_skiplist);
1230 DEFSUBR(Fskiplist_to_alist);
1231 DEFSUBR(Fskiplist_to_plist);
1232 DEFSUBR(Falist_to_skiplist);
1233 DEFSUBR(Fplist_to_skiplist);
1237 skiplist_reinit(void)
1239 morphisms[lrecord_type_skiplist].seq_impl = seq_skiplist;
1240 morphisms[lrecord_type_skiplist].aset_impl = dict_skiplist;
1244 void vars_of_skiplist(void)
1246 Fprovide(intern("skiplist"));
1249 /* skiplist.c ends here*/