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)
414 write_fmt_str(printcharfun, "#<skiplist :size %lu :levels %lu >",
415 (long unsigned int)XSKIPLIST_NNODES(obj),
416 (long unsigned int)XSKIPLIST_NLEVELS(obj));
420 finalise_skiplist(void *header, int UNUSED(for_disksave))
422 skiplist_t sl = header;
424 SL_DEBUG("*** SXEmacs: skiplist finalisation 0x%lx\n",
425 (long unsigned int)sl);
427 /* traverse the skiplist and free all node and data cells */
428 for (skiplist_level_t tmp = next_node(skiplist_foot(sl)); tmp; ) {
429 volatile skiplist_level_t nex = next_node(tmp);
430 SL_DEBUG_NODE("freeing 0x%lx\n",
431 (long unsigned int)tmp->node);
432 free_skiplist_node(tmp->node);
436 /* free skiplist head levels */
439 /* and finally commit suicide */
444 skiplist_getprop(Lisp_Object obj, Lisp_Object property)
446 return external_plist_get(&XSKIPLIST_PLIST(obj), property, 0, ERROR_ME);
450 skiplist_putprop(Lisp_Object obj, Lisp_Object property, Lisp_Object value)
452 external_plist_put(&XSKIPLIST_PLIST(obj), property, value, 0, ERROR_ME);
457 skiplist_remprop(Lisp_Object obj, Lisp_Object property)
459 return external_remprop(&XSKIPLIST_PLIST(obj), property, 0, ERROR_ME);
462 DEFUN("skiplist-plist", Fskiplist_plist, 1, 1, 0, /*
463 Return the property list of SKIPLIST.
467 CHECK_SKIPLIST(skiplist);
468 return XSKIPLIST_PLIST(skiplist);
471 static const struct lrecord_description skiplist_description[] = {
472 {XD_OPAQUE_PTR, offsetof(struct skiplist_s, headlevs)},
473 {XD_INT, offsetof(struct skiplist_s, nnodes)},
474 {XD_INT, offsetof(struct skiplist_s, nlevels)},
475 {XD_LISP_OBJECT, offsetof(struct skiplist_s, plist)},
479 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS("skiplist", skiplist,
480 mark_skiplist, print_skiplist,
483 skiplist_description,
490 static inline skiplist_t
491 allocate_skiplist(void)
492 __attribute__((always_inline));
493 static inline skiplist_t
494 allocate_skiplist(void)
496 skiplist_t skiplist =
497 alloc_lcrecord_type(struct skiplist_s, &lrecord_skiplist);
504 skiplist_t sl = allocate_skiplist();
507 /* the categories are actually seq and dict, but use the per-type
508 implementation for a start */
509 sl->lheader.lheader.morphisms = (1<<cat_mk_lc);
511 sl->headlevs = make_skiplist_levels(NULL, MAX_SKIPLIST_HEIGHT);
512 skiplist_nnodes(sl) = 0;
513 skiplist_nlevels(sl) = 0; /* means 1 actually */
514 skiplist_plist(sl) = Qnil;
516 XSETSKIPLIST(result, sl);
521 DEFUN("make-skiplist", Fmake_skiplist, 0, 0, 0, /*
522 Return a new empty skiplist object.
526 /* gotta seed our oracle; this is a stupid seed value though */
527 return make_skiplist();
532 DEFUN("skiplistp", Fskiplistp, 1, 1, 0, /*
533 Return non-nil if OBJECT is a skiplist.
537 if (SKIPLISTP(object)) {
544 DEFUN("skiplist-empty-p", Fskiplist_empty_p, 1, 1, 0, /*
545 Return non-nil if SKIPLIST is empty.
549 CHECK_SKIPLIST(skiplist);
551 if (XSKIPLIST_NNODES(skiplist) == 0) {
558 /* modifiers and accessors */
560 _put_skiplist(skiplist_t sl, skiplist_level_t *path, size_t psz,
561 hcode_t h, Lisp_Object key, Lisp_Object value)
563 /* entirely new data, build a node for it */
564 /* determine the number of levels to add */
565 size_t nlevels = __ase_ffsl(random()), cnt;
566 skiplist_level_t levels, last = path[psz--];
567 skiplist_node_t node;
569 node = _make_skiplist_node(h, key, value, nlevels);
574 add_level_neighbour(last, node->foot /* level[0] */);
576 if (LIKELY(nlevels <= psz)) {
581 for (size_t i = 1; i <= cnt; i++) {
582 skiplist_level_t level = &levels[i];
584 SL_DEBUG_LEVEL("created level 0x%lx\n",
585 (long unsigned int)level);
587 last = /* skiplist_path_pop(path) */ path[psz--];
588 SL_DEBUG("last 0x%lx "
590 (long unsigned int)last,
591 (long unsigned int)level);
592 add_level_neighbour(last, level);
594 for (size_t i = cnt+1; i <= nlevels; i++) {
595 skiplist_level_t newhlevel = raise_head_level(sl);
596 skiplist_level_t level = &levels[i];
598 SL_DEBUG("head level 0x%lx "
600 (long unsigned int)newhlevel,
601 (long unsigned int)level);
602 add_level_neighbour(newhlevel, level);
608 put_skiplist(skiplist_t sl, Lisp_Object key, Lisp_Object value)
610 skiplist_level_t last;
611 /* C99 we need you */
612 skiplist_level_t path[skiplist_nlevels(sl)+2];
613 hcode_t hkey = skiplist_hash(key);
617 last = path[lastidx = skiplist_find_hash_path(sl, hkey, path)];
619 if (UNLIKELY(/* skiplist_path_size(path) == 0 */ lastidx == 0 ||
620 /* skiplist_pop(path) == NULL */ last == NULL)) {
624 /* hash this prick */
625 h = skiplist_hash(key);
627 /* now either we have to insert, or replace */
628 /* for that we check if the element right of left is by chance
629 * the thing we look for */
630 if (UNLIKELY(h == level_hash(next_node(last)))) {
631 skiplist_level_t level = next_node(last);
633 if (UNLIKELY(!skiplist_keyeq(key, level_key(level)))) {
634 SL_CRITICAL("*** SXEmacs CRITICAL: "
635 "non trivial skiplist collision :(\n");
638 /* oh, we have to replace, we just nuke the old
639 * data cell and replace it with the new one
641 SL_DEBUG("*** SXEmacs: skiplist collision, replace\n");
642 node_data_key(parent_node(level)) = key;
643 node_data_value(parent_node(level)) = value;
646 _put_skiplist(sl, path, lastidx, h, key, value);
651 DEFUN("put-skiplist", Fput_skiplist, 3, 3, 0, /*
652 Add KEY to the SKIPLIST and assign VALUE.
654 (skiplist, key, value))
656 CHECK_SKIPLIST(skiplist);
658 put_skiplist(XSKIPLIST(skiplist), key, value);
664 get_skiplist(skiplist_t sl, Lisp_Object key, Lisp_Object default_)
666 skiplist_node_t node;
667 skiplist_level_t level;
669 if (UNLIKELY((level = skiplist_find_level(sl, key)) == NULL)) {
673 /* level points to rightmost and footmost level to the left of key */
674 if (next_node(level)) {
675 level = next_node(level);
678 if (!(node = level->node)) {
682 if (!(skiplist_keyeq(node_data_key(node), key))) {
686 return node_data_value(node);
689 DEFUN("get-skiplist", Fget_skiplist, 2, 3, 0, /*
690 Return the value of KEY in SKIPLIST.
691 If KEY is not an element, return `nil' instead or --
692 if specified -- DEFAULT.
694 (skiplist, key, default_))
696 CHECK_SKIPLIST(skiplist);
698 return get_skiplist(XSKIPLIST(skiplist), key, default_);
702 remove_skiplist(skiplist_t sl, Lisp_Object key)
703 /* remove KEY from SKIPLIST (pathless approach) */
705 skiplist_node_t node;
706 skiplist_level_t level, last;
707 /* C99 we need you! */
708 skiplist_level_t path[skiplist_nlevels(sl)+2];
709 hcode_t hkey = skiplist_hash(key);
712 lastidx = skiplist_find_hash_path(sl, hkey, path);
713 last = path[lastidx];
715 if (/* skiplist_path_size(path) == 0 */ lastidx == 0 ||
716 /* skiplist_last(path) == NULL */ path[0] == NULL) {
720 if (hkey == level_hash(next_node(last)) &&
721 skiplist_keyeq(key, level_key(next_node(last)))) {
722 node = parent_node(next_node(last));
724 /* traverse (bottom-up) the level structure
725 * and free any occurring level pointers */
726 while (lastidx > 0 /* because we `popped' the head */ &&
728 /* skiplist_path_pop(path) */
729 path[lastidx--]) != skiplist_path_nil &&
731 parent_node(next_node(last)) == node) {
732 level = next_node(last);
733 next_node(last) = next_node(level);
736 /* free node (kill data cell and levels with it) */
737 free_skiplist_node(node);
738 /* decrement skiplist size */
739 skiplist_nnodes(sl)--;
741 /* now, the skiplist head might have many nil pointers
742 * we reduce the overall levelling in that case */
743 reconcile_levelling(sl);
748 DEFUN("remove-skiplist", Fremove_skiplist, 2, 2, 0, /*
749 Remove the element specified by KEY from SKIPLIST.
750 If KEY is not an element, this is a no-op.
754 CHECK_SKIPLIST(skiplist);
756 remove_skiplist(XSKIPLIST(skiplist), key);
761 /* C99 where are you? */
763 skiplist_owns_p(skiplist_t skiplist, Lisp_Object key)
764 /* return !0 iff SKIPLIST has a node for KEY */
766 skiplist_node_t node;
767 skiplist_level_t level;
768 hcode_t hkey = skiplist_hash(key);
770 level = skiplist_find_hash_return_level(skiplist, hkey);
772 if (level == skiplist_path_nil) {
776 /* level points to rightmost and footmost level to the left of key */
777 if (next_node(level))
778 level = next_node(level);
780 if ((node = level->node) == NULL) {
784 if (!(skiplist_keyeq(node_data_key(node), key))) {
791 DEFUN("skiplist-owns-p", Fskiplist_owns_p, 2, 2, 0, /*
792 Return non-nil if KEY is associated with a value in SKIPLIST.
796 CHECK_SKIPLIST(skiplist);
798 return (skiplist_owns_p(XSKIPLIST(skiplist), key) ? Qt : Qnil);
802 /* informational cruft */
803 DEFUN("skiplist-size", Fskiplist_size, 1, 1, 0, /*
804 Return the size of SKIPLIST, that is the number of elements.
808 CHECK_SKIPLIST(skiplist);
809 return make_int((int32_t)XSKIPLIST_NNODES(skiplist));
814 copy_skiplist(skiplist_t skiplist)
816 Lisp_Object result = make_skiplist();
817 skiplist_t sl_copy = XSKIPLIST(result);
818 skiplist_level_t tmp;
819 Lisp_Object key, val;
821 /* traverse the skiplist */
822 tmp = next_node(skiplist_foot(skiplist));
824 key = node_data_key(parent_node(tmp));
825 val = node_data_value(parent_node(tmp));
826 put_skiplist(sl_copy, key, val);
827 tmp = next_node(tmp);
832 DEFUN("copy-skiplist", Fcopy_skiplist, 1, 1, 0, /*
833 Return a copy of skiplist SKIPLIST.
834 The elements of SKIPLIST are not copied; they are shared
840 CHECK_SKIPLIST(skiplist);
842 return copy_skiplist(XSKIPLIST(skiplist));
845 void unite_skiplist(skiplist_t target, skiplist_t source)
847 /* unite target and source and store result in target */
848 Lisp_Object key, value;
849 skiplist_level_t lev;
851 lev = next_node(skiplist_foot(source)); /* start at the bottom */
853 key = node_data_key(parent_node(lev));
854 value = node_data_value(parent_node(lev));
855 put_skiplist(target, key, value);
856 lev = next_node(lev);
860 DEFUN("skiplist-union", Fskiplist_union, 0, MANY, 0, /*
861 Return the union skiplist of SKIPLISTS.
862 Args are &rest SKIPLIST.
864 The union is a skiplist containing all key-value-pairs which are
865 in at least one of the SKIPLISTS.
867 Note: Key-value-pairs with equal keys and distinct values are
868 processed from left to right, that is the final union for such pairs
869 contains the value of the rightmost skiplist in @var{skiplists}.
871 (int nargs, Lisp_Object *args))
876 for (i=0; i<nargs; i++)
877 CHECK_SKIPLIST(args[i]);
879 result = make_skiplist();
880 for (i=0; i<nargs; i++) {
881 unite_skiplist(XSKIPLIST(result), XSKIPLIST(args[i]));
886 void intersect_skiplist(skiplist_t target, skiplist_t source)
888 /* intersect target and source and store result in target */
890 skiplist_level_t lev;
892 lev = next_node(skiplist_foot(target)); /* start at the bottom */
894 key = node_data_key(parent_node(lev));
895 lev = next_node(lev);
896 if (!skiplist_owns_p(source, key)) {
897 remove_skiplist(target, key);
899 lev = next_node(lev);
904 DEFUN("skiplist-intersection", Fskiplist_intersection, 0, MANY, 0, /*
905 Return the intersection skiplist of SKIPLISTS.
906 Args are &rest SKIPLIST.
908 The intersection is a skiplist containing all key-value-pairs
909 which are in all skiplists of SKIPLISTS.
911 Note: Key-value-pairs with equal keys and distinct values are
912 processed from right to left, that is the final intersection for such
913 pairs contains the value of the leftmost skiplist in SKIPLISTS.
915 (int nargs, Lisp_Object *args))
921 return make_skiplist();
923 for (i=0; i<nargs; i++)
924 CHECK_SKIPLIST(args[i]);
926 result = copy_skiplist(XSKIPLIST(args[0]));
927 for (i=1; i<nargs; i++) {
928 intersect_skiplist(XSKIPLIST(result), XSKIPLIST(args[i]));
934 map_skiplist(skiplist_t sl, skiplist_map_f mapf)
936 skiplist_level_t lev;
938 lev = next_node(skiplist_foot(sl)); /* start at the bottom */
941 k = node_data_key(parent_node(lev));
942 v = node_data_value(parent_node(lev));
945 lev = next_node(lev);
951 map2_skiplist(skiplist_t sl, skiplist_map2_f mapf, void *ptr)
953 skiplist_level_t lev;
955 lev = next_node(skiplist_foot(sl)); /* start at the bottom */
958 k = node_data_key(parent_node(lev));
959 v = node_data_value(parent_node(lev));
962 lev = next_node(lev);
967 DEFUN("map-skiplist", Fmap_skiplist, 2, 2, 0, /*
968 Map FUNCTION over entries in SKIPLIST, calling it with two args,
969 each key and value in SKIPLIST.
971 FUNCTION may not modify SKIPLIST, with the one exception that FUNCTION
972 may remove or reput the entry currently being processed by FUNCTION.
974 (function, skiplist))
978 skiplist_level_t lev;
979 struct gcpro gcpro1, gcpro2;
981 CHECK_SKIPLIST(skiplist);
983 GCPRO2(function, skiplist);
984 sl = XSKIPLIST(skiplist);
985 lev = next_node(skiplist_foot(sl)); /* start at the bottom */
988 args[1] = node_data_key(parent_node(lev));
989 args[2] = node_data_value(parent_node(lev));
991 Ffuncall(countof(args), args);
992 lev = next_node(lev);
1001 DEFUN("skiplist-to-alist", Fskiplist_to_alist, 1, 1, 0, /*
1002 Return the ordinary association list induced by SKIPLIST.
1006 Lisp_Object result = Qnil;
1007 skiplist_level_t tmp;
1008 Lisp_Object key, val;
1010 CHECK_SKIPLIST(skiplist);
1012 /* traverse the skiplist */
1013 tmp = next_node(XSKIPLIST_FOOT(skiplist));
1015 key = node_data_key(parent_node(tmp));
1016 val = node_data_value(parent_node(tmp));
1017 result = Fcons(Fcons(key, val), result);
1018 tmp = next_node(tmp);
1024 DEFUN("skiplist-to-plist", Fskiplist_to_plist, 1, 1, 0, /*
1025 Return the ordinary association list induced by SKIPLIST.
1029 Lisp_Object result = Qnil;
1030 skiplist_level_t tmp;
1031 Lisp_Object key, val;
1033 CHECK_SKIPLIST(skiplist);
1035 /* traverse the skiplist */
1036 tmp = next_node(XSKIPLIST_FOOT(skiplist));
1038 key = node_data_key(parent_node(tmp));
1039 val = node_data_value(parent_node(tmp));
1040 result = Fcons(val, result);
1041 result = Fcons(key, result);
1042 tmp = next_node(tmp);
1048 DEFUN("alist-to-skiplist", Falist_to_skiplist, 1, 1, 0, /*
1049 Return a skiplist from ALIST with equal key space and image.
1053 Lisp_Object result = make_skiplist();
1054 skiplist_t sl = XSKIPLIST(result);
1055 Lisp_Object tmp, key, val;
1059 /* traverse the alist */
1061 while (!NILP(tmp)) {
1062 key = XCAR(XCAR(tmp));
1063 val = XCDR(XCAR(tmp));
1065 put_skiplist(sl, key, val);
1073 DEFUN("plist-to-skiplist", Fplist_to_skiplist, 1, 1, 0, /*
1074 Return a skiplist from PLIST with equal key space and image.
1078 Lisp_Object result = make_skiplist();
1079 skiplist_t sl = XSKIPLIST(result);
1080 Lisp_Object tmp, key, val;
1084 /* traverse the plist */
1086 while (!NILP(tmp)) {
1088 val = XCAR(XCDR(tmp));
1090 put_skiplist(sl, key, val);
1092 tmp = Fcdr(Fcdr(tmp));
1099 /* iterator crap, only needed for dict so make it static */
1101 skiplist_iter_init(dict_t d, dict_iter_t di)
1104 /* go to the bottommost level */
1105 di->data = next_node(skiplist_foot((skiplist_t)d));
1110 skiplist_iter_fini(dict_iter_t di)
1112 di->dict = di->data = NULL;
1116 /* the next one is for dicts only */
1118 skiplist_diter_next(dict_iter_t di, Lisp_Object *key, Lisp_Object *val)
1120 skiplist_level_t sll = di->data;
1122 if (LIKELY(sll != NULL)) {
1123 *key = node_data_key(parent_node(sll));
1124 *val = node_data_value(parent_node(sll));
1125 di->data = next_node(sll);
1127 *key = *val = Qnull_pointer;
1132 /* and the one for seqs */
1134 skiplist_siter_next(seq_iter_t di, void **elm)
1136 skiplist_level_t sll = di->data;
1138 if (LIKELY(sll != NULL)) {
1139 *elm = (void*)node_data_key(parent_node(sll));
1140 di->data = next_node(sll);
1142 *elm = Qnull_pointer;
1148 skiplist_iter_reset(seq_iter_t si)
1150 /* go to the bottommost level */
1151 si->data = next_node(skiplist_foot((skiplist_t)si->seq));
1156 skiplist_explode(void *restrict tgt[], size_t ntgt, const seq_t s)
1158 volatile size_t i = 0;
1159 volatile skiplist_level_t n = next_node(skiplist_foot((skiplist_t)s));
1161 while (n != NULL && i < ntgt) {
1162 tgt[i++] = (void*)node_data_key(parent_node(n));
1170 * Initialisation stuff
1172 static struct dict_impl_s __dskiplist = {
1173 .size_f = (dict_size_f)skiplist_size,
1174 .put_f = (dict_put_f)put_skiplist,
1175 .get_f = (dict_get_f)get_skiplist,
1176 .remove_f = (dict_remove_f)remove_skiplist,
1177 .iter_init_f = skiplist_iter_init,
1178 .iter_next_f = skiplist_diter_next,
1179 .iter_fini_f = skiplist_iter_fini,
1182 static struct seq_impl_s __sskiplist = {
1183 .length_f = (seq_length_f)skiplist_size,
1184 .iter_init_f = (seq_iter_init_f)skiplist_iter_init,
1185 .iter_next_f = skiplist_siter_next,
1186 .iter_fini_f = (seq_iter_fini_f)skiplist_iter_fini,
1187 .iter_reset_f = skiplist_iter_reset,
1188 .explode_f = skiplist_explode,
1191 /* deal with dict interface */
1192 const dict_impl_t dict_skiplist = &__dskiplist;
1193 /* deal with the seq interface (actually a set interface) */
1194 const seq_impl_t seq_skiplist = &__sskiplist;
1196 void syms_of_skiplist(void)
1198 INIT_LRECORD_IMPLEMENTATION(skiplist);
1200 defsymbol(&Qskiplistp, "skiplistp");
1202 DEFSUBR(Fmake_skiplist);
1203 DEFSUBR(Fskiplist_plist);
1205 DEFSUBR(Fskiplistp);
1206 DEFSUBR(Fskiplist_empty_p);
1208 DEFSUBR(Fput_skiplist);
1209 DEFSUBR(Fget_skiplist);
1210 DEFSUBR(Fremove_skiplist);
1211 DEFSUBR(Fskiplist_owns_p);
1213 DEFSUBR(Fskiplist_size);
1215 DEFSUBR(Fcopy_skiplist);
1216 DEFSUBR(Fskiplist_union);
1217 DEFSUBR(Fskiplist_intersection);
1218 DEFSUBR(Fmap_skiplist);
1220 #ifdef SKIPLIST_DEBUG_FLAG
1221 DEFSUBR(Flist_skiplist);
1224 DEFSUBR(Fskiplist_to_alist);
1225 DEFSUBR(Fskiplist_to_plist);
1226 DEFSUBR(Falist_to_skiplist);
1227 DEFSUBR(Fplist_to_skiplist);
1231 skiplist_reinit(void)
1233 morphisms[lrecord_type_skiplist].seq_impl = seq_skiplist;
1234 morphisms[lrecord_type_skiplist].aset_impl = dict_skiplist;
1238 void vars_of_skiplist(void)
1240 Fprovide(intern("skiplist"));
1243 /* skiplist.c ends here*/