; Copyright (c) 2011-2019, Juergen Lorenz
; All rights reserved.
; 
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are
; met:
; 
; Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
; 
; Redistributions in binary form must reproduce the above copyright
; notice, this list of conditions and the following disclaimer in the
; documentation and/or other materials provided with the distribution.
; 
; Neither the name of the author nor the names of its contributors may be
; used to endorse or promote products derived from this software without
; specific prior written permission. 
; 
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
; 
; Author: Juergen Lorenz
;         ju (at) jugilo (dot) de
;
; Last update: Mar 25, 2019
;
;Rationale
;=========
;
;Skiplists are data-types, which can replace balanced search-trees. They
;are invented by Pugh. The idea is as follows:
;
;Contrary to listnodes, which are pairs of an item and a next pointer,
;skipnodes are pairs of an item and a vector of next pointers. The
;length' of these vectors depend on each skipnode itself. They are
;choosen randomly in such a way, that, in the average, the number of
;nodes with at least k links is half the number of links with at least
;k-1 links, for k>1. Following the next pointers at a fixed link-level,
;k say, one skips all nodes with less than k pointers.
;
;Inserting an item into a skiplist now works as follows.
;First one packages the item into a skipnode, where the number of links
;is generated randomly as described above.
;Second, one follows the skiplist along the highest occupied number of
;links as long as the skiplist's nodes point to items less then the item
;of the node to be inserted.
;Third, one steps down one level and continues following the skiplist's
;nodes at this new smaller level.
;Repeating this process until level 0 is reached we eventually find the
;place where our new node is to be inserted.
;
;Some additional remarks are in order.
;
;We described the process with a width of two, i.e. at each level in the
;average one node of the level below is skipped.  A higher value than two
;for the width is possible as well, trading performance against space.
;
;We have to decide, what to do with duplicates. We choose the following
;approach: The skiplist itself stores a list of either one or several numerical
;comparison operators. Only if the last of those operators is the special
;comparison operator dups (which returns constantly 0, i.e. it compares
;nothing) duplicates are allowed. Moreover, we arrage matters in such a
;way, that all nodes of duplicates with the same key have the same
;height, so that a search for the item which was inserted last will be
;found first.


(module %skiplists
  (skiplists skiplist skiplist? skiplist->list sl-null?
   sl-item? sl-found?  sl-dups? sl-insert! sl-remove!
   sl-clear! sl-search! sl-orders
   sl-compare sl-width sl-height
   sl-found sl-filter sl-map
   sl-for-each sl-reorder sl-restructure
   sl-count sl-search-level sl-min
   sl-max sl-max-height dups) 

(import scheme
  (only (chicken base)
        define-record-type define-record-printer optional when unless
        case-lambda void identity list-of? gensym vector-resize
        getter-with-setter setter print error)
  (only (chicken condition) condition-case)
  (only (chicken fixnum) fx+ fx- fx>= fx> fx< fx= fxmin)
  (only (chicken format) format)
  (only (chicken random) pseudo-random-integer))

(define-syntax do-while ; hidden
  (syntax-rules ()
    ((_ test? xpr xpr1 ...)
     (let loop ()
       (if test?
         (begin
           xpr xpr1 ...
           (loop)))))))

;; trivial comparison operator to allow duplicates
;; must be the last order in the orders list
(define (dups x y)
  0)

;;;; snode ADT (hidden)

(define-record-type snode
  (make-snode item next)
  snode?
  (item snode-item)
  (next snode-next))

;;; constructor
(define (snode item height)
  (make-snode item (make-vector height '())))

;; items of the first and last snode
(define gstart (gensym 'start))
(define gfinish (gensym 'finish))

(define (snode-finish? node)
  (eq? (snode-item node) gfinish))

(define (snode-start? node)
  (eq? (snode-item node) gstart))

(define snode-next-ref
  (getter-with-setter
    (lambda (node k)
      (vector-ref (snode-next node) k))
    (lambda (node k new)
      (vector-set! (snode-next node) k new))))

(define-record-printer (snode node out)
  (format out "~S#~S"
          (snode-item node) (snode-height node)))

(define (snode-height node)
  (vector-length (snode-next node)))

(define-record-type skiplist
  (make-skiplist width max-height item? orders height count start cursor found level finish)
  skiplist?
  (width sl-width)
  (max-height sl-max-height)
  (item? sl-item?)
  (orders sl-orders)
  ;; setters not exported, cursor not exported
  (height sl-height sl-height-set!)
  (count sl-count sl-count-set!)
  (start sl-start (setter sl-start))
  (cursor sl-cursor (setter sl-cursor)) ; vector of nodes
  (found sl-found sl-found-set!)
  (level sl-search-level sl-search-level-set!)
  (finish sl-finish (setter sl-finish)))

(define (repeat-string str k) ; internal
  (let loop ((k k) (result ""))
    (if (zero? k)
      result
      (loop (fx- k 1) (string-append str result)))))

(define-record-printer (skiplist sls out)
  (format out "#,(skiplist[dups: ~s width: ~s height: ~s count: ~s]"
          (sl-dups? sls)
          (sl-width sls)
          (sl-height sls)
          (sl-count sls))
  (if (sl-null? sls)
    (display ")" out)
    ;(format out " ~s ... ~s)" (sl-min sls) (sl-max sls))))
    (let ((smin (sl-min sls)) (smax (sl-max sls)))
      (format out "~? ...~?)~%"
              (repeat-string " ~s" (length smin)) smin
              (repeat-string " ~s" (length smax)) smax))))

;; constructor
(define skiplist
  (case-lambda
    ((width max-height item? order . orders)
     (let* ((finish (snode gfinish max-height))
            (start (make-snode gstart (make-vector max-height finish))))
       (make-skiplist width
                      max-height
                      item?
                      (cons order orders)
                      1 ; height
                      0 ; count
                      start
                      (vector start) ; cursor
                      '() ; found
                      0 ; level
                      finish)))
    ((max-height item? order . orders)
     (apply skiplist 2 max-height item? order orders))
    ((item? order . orders)
     (apply skiplist 2 10 item? order orders))))


(define (sl-dups? sls)
  ;; dups as last item in the orders list
  (let ((dups? (memq dups (sl-orders sls))))
    (and dups? (null? (cdr dups?)))))

(define (sl-null? sls)
  (zero? (sl-count sls)))

(define (sl-found? sls item)
  (member item (sl-found sls)))

;; combine orders
(define (sl-compare sls)
  (let loop ((orders (sl-orders sls)))
    (unless (null? orders)
      (let ((cmp (car orders)) (rest (cdr orders)))
        (if (null? rest)
          cmp
          (lambda (x y)
            (if (zero? (cmp x y))
              ((loop rest) x y)
              (cmp x y))))))))

;; compare items
(define (sl-less? sls item0 item1)
  (cond
    ((eq? item0 gstart) #t)
    ((eq? item0 gfinish) #f)
    ((eq? item1 gstart) #f)
    ((eq? item1 gfinish) #t)
    (else
      (negative?
        ((sl-compare sls) item0 item1)))))

(define (sl-equal? sls item0 item1)
  (and (not (sl-less? sls item0 item1))
       (not (sl-less? sls item1 item0))))

(define (cursor-less? sls k item) ; internal
  (sl-less? sls (snode-item (cursor-next sls k)) item))

(define (cursor-equal? sls k item) ; internal
  (sl-equal? sls (snode-item (cursor-next sls k)) item))

;; all operations should happen at the cursor, where it is moved in such
;; a way, that is less than a node but points to a node which is not

(define cursor-ref ; internal
  (getter-with-setter
    (lambda (sls k)
      (vector-ref (sl-cursor sls) k))
    (lambda (sls k node)
      (vector-set! (sl-cursor sls) k node))))

(define cursor-next ; internal
  (getter-with-setter
    (lambda (sls k)
      (snode-next-ref (cursor-ref sls k) k))
    (lambda (sls k new)
      (set! (snode-next-ref (cursor-ref sls k) k) new))))

(define sl-start-next
  (getter-with-setter
    (lambda (sls k)
      (snode-next-ref (sl-start sls) k))
    (lambda (sls k node)
      (set! (snode-next-ref (sl-start sls) k) node))))

;; cursor movements
(define (cursor-forth! sls k) ; internal
  (set! (cursor-ref sls k)
        (cursor-next sls k)))

(define (cursor-moveto! sls k item) ; internal
  (do-while (cursor-less? sls k item)
            (cursor-forth! sls k)))

(define (cursor-start! sls k) ; internal
  (set! (cursor-ref sls k)
        (sl-start-next sls k)))

;;; this is where the work gets done!
;;; it's only needed in sl-max, but a pattern for sl-search!
;(define (cursor-prepare! sls item)
;  (let* ((height (sl-height sls)) (top (fx- height 1)))
;    ;; save cursors at every level
;    (do ((k top (fx- k 1)))
;      ((negative? k))
;      (if (fx= k top)
;        ;;; restart cursor at highest level only if cursor not less item
;        (if (not (cursor-less? sls k item))
;          (set! (cursor-ref sls k) (sl-start sls)))
;        ;; start at every lower cursor level with the result of the level above
;        (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
;      ;; advance cursor horizontally
;      (cursor-moveto! sls k item))))

;; the same as cursor-prepare!, but stops earlier, if item found
;; and collects found items
(define (sl-search! sls item)
  (call-with-current-continuation
    (lambda (out)
      (let ((top (fx- (sl-height sls) 1)))
        ;; save cursors at every level
        (do ((k top (fx- k 1)))
          ((negative? k))
          (if (fx= k top)
            ;;; restart cursor at highest level only if cursor not less item
            (if (not (cursor-less? sls k item))
              (set! (cursor-ref sls k) (sl-start sls)))
            ;; start at every lower cursor level with the result of the level above
            (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
          ;; advance cursor horizontally
          (cursor-moveto! sls k item)
          (if (cursor-equal? sls k item) ; item found
            (begin
              (sl-search-level-set! sls k)
              ;; collect found items
              (let loop ((node (cursor-next sls k)) (found '()))
                (if (not (sl-equal? sls (snode-item node) item))
                  (sl-found-set! sls (reverse found))
                  (loop (snode-next-ref node k)
                        (cons (snode-item node) found))))
              (out (void)))
            (begin
              (sl-found-set! sls '())
              (sl-search-level-set! sls k))))))))

(define (sl-search-continue! sls item)
  ;; save cursors at every level below search level
  (do ((k (fx- (sl-search-level sls) 1) (fx- k 1)))
    ((negative? k))
      ;; restart cursor at every lower cursor level with the result of the level above
    (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1)))
    ;; advance cursor horizontally
    (cursor-moveto! sls k item)))

(define (choose-height width) ; internal
  (let loop ((choice (pseudo-random-integer width)) (k 1))
    (if (fx>= choice 1)
      k
      (loop (pseudo-random-integer width) (fx+ k 1)))))

(define (sl-insert! sls item . items)
  (let ((height (fxmin (sl-max-height sls)
                       (choose-height (sl-width sls)))))
    ;; restructure
    (when (> height (sl-height sls))
      ;(set! (sl-finish sls) (snode gfinish height))
      ;(set! (sl-start sls)
      ;      (make-snode gstart
      ;                  (vector-resize (snode-next (sl-start sls))
      ;                                 height
      ;                                 (sl-finish sls))))
      (set! (sl-cursor sls)
            (vector-resize (sl-cursor sls)
                           height
                           (sl-start sls)))
      (sl-search-level-set! sls height)
      (sl-height-set! sls height))
    ;; insert
    (if (sl-dups? sls)
      (begin
        ;; prepare upper part of cursor for insertion
        (sl-search! sls item) ; ok
        (let* (
          ;; the new node should have the same height as the
          ;; found one so removing all is fast
          (height (if (null? (sl-found sls))
                    height
                    (snode-height
                      (cursor-next sls (sl-search-level sls)))))
          (new (snode item height))
          )
          ;; prepare lower part of cursor for insertion
          (sl-search-continue! sls item)
          (sl-count-set! sls (fx+ (sl-count sls) 1))
          (sl-found-set! sls (cons item (sl-found sls)))
          (do ((k 0 (fx+ k 1)))
            ((fx= k height))
            (set! (snode-next-ref new k)
                  (cursor-next sls k))
            (set! (cursor-next sls k) new))))
      (begin
        ;; prepare upper part of cursor
        (sl-search! sls item)
        (when (null? (sl-found sls))
          ;; prepare lower part of cursor
          (sl-search-continue! sls item)
          (let ((new (snode item height)))
            (sl-count-set! sls (fx+ (sl-count sls) 1))
            (do ((k 0 (fx+ k 1)))
              ((fx= k height))
              (set! (snode-next-ref new k)
                    (cursor-next sls k))
              (set! (cursor-next sls k) new)))))))
  ;; insert additional items, if there are any
  (do ((items items (cdr items)))
    ((null? items))
    (sl-insert! sls (car items))))

(define (sl-remove! sls item . items)
  ;; remove one item if found
  (sl-search! sls item)
  (if (member item (sl-found sls))
    (unless (null? (sl-found sls))
      (let ((level (sl-search-level sls)))
        ;; advance horizontally until item found
        (do-while
          (not (equal? item
                       (snode-item (cursor-next sls level))))
          (cursor-forth! sls level))
        (sl-search-continue! sls item)
        (when (cursor-equal? sls level item)
          (set! (cursor-next sls level)
                (snode-next-ref (cursor-next sls level) level))
          (sl-count-set! sls (fx- (sl-count sls) 1))
          (sl-found-set! sls (cdr (sl-found sls)))
          (do ((k 0 (fx+ k 1)))
            ((fx= k level))
            (when (cursor-equal? sls k item)
              (set! (cursor-next sls k)
                    (snode-next-ref (cursor-next sls k) k))))))))
  ;; remove other items, if any
  (do ((items items (cdr items)))
    ((null? items))
    (sl-remove! sls (car items))))

(define (sl-for-each proc sls)
  (do ((node (snode-next-ref (sl-start sls) 0)
             (snode-next-ref node 0)))
    ((snode-finish? node)) ; way out
    (display "XXXX") (display (snode-item node))
    (proc (snode-item node))))

(define (sl-clear! sls)
  (sl-height-set! sls 1)
  (set! (sl-finish sls) (snode gfinish 1))
  (set! (sl-start sls) (snode gstart 1))
  (set! (sl-start-next sls 0) (sl-finish sls))
  (set! (sl-cursor sls) (make-vector 1 (sl-start sls)))
  (sl-count-set! sls 0))

(define (sl-map proc sls . target-structure)
  (let (
    (result
      (cond
        ;; old width and orders
        ((null? target-structure)
         (apply skiplist (sl-width sls) (sl-item? sls) (sl-orders sls)))
        ;; old width, new item? and orders
        (((list-of? procedure?) target-structure)
         (apply skiplist (sl-width sls) target-structure))
        ;; new width, old item? and orders
        ((null? (cdr target-structure))
         (apply skiplist (car target-structure) (sl-item? sls) (sl-orders sls)))
        ;; new width, new item? and orders
        (else
          (apply skiplist target-structure))))
    )
    (do ((node (snode-next-ref (sl-start sls) 0)
               (snode-next-ref node 0)))
      ((snode-finish? node)) ; way out
      (sl-insert! result (proc (snode-item node))))
    result))

(define (sl-restructure sls width max-height)
  ;(sl-map sls identity width))
  (let ((result (apply skiplist
                       width
                       max-height
                       (sl-item? sls)
                       (sl-orders sls))))
    (do ((node (snode-next-ref (sl-start sls) 0) (snode-next-ref node 0)))
      ((snode-finish? node))
      (sl-insert! result (snode-item node)))
    result))

(define (sl-reorder sls order . orders)
  ;(apply sl-map sls identity order orders))
  (let ((result (apply skiplist
                       (sl-width sls)
                       (sl-max-height sls)
                       (sl-item?  sls)
                       order orders)))
    (do ((node (snode-next-ref (sl-start sls) 0) (snode-next-ref node 0)))
      ((snode-finish? node))
      (sl-insert! result (snode-item node)))
    result))

(define (sl-filter ok? sls)
  (let ((result (apply skiplist
                       (sl-width sls)
                       (sl-max-height sls)
                       (sl-item?  sls)
                       (sl-orders sls))))
    (do ((node (snode-next-ref (sl-start sls) 0)
               (snode-next-ref node 0)))
      ((snode-finish? node)) ; way out
      (let ((item (snode-item node)))
        (if (ok? item) (sl-insert! result item))))
    result))

(define (sl-min sls)
  (if (sl-null? sls)
    '()
    (begin
      (cursor-start! sls 0)
      ;(snode-item (cursor-ref sls 0)))
      (sl-search! sls (snode-item (cursor-ref sls 0)))
      (sl-found sls))))
  ;(let ((item (snode-item (cursor-ref sls 0))))
  ;  (if (sl-dups? sls)
  ;    (begin
  ;      (sl-search! sls item)
  ;      (sl-found sls))
  ;    item)))

(define (sl-max sls)
  ;; sl-search! won't work since gfinish is of wrong type;
  ;; moreover it stores the next item in found, wheras max is the
  ;; present item at level 0 after moveto!
  (if (sl-null? sls)
    '()
    (begin 
      (let ((top (fx- (sl-height sls) 1)))
        ;; save cursors at every level
        (do ((k top (fx- k 1)))
          ((negative? k))
          ;; at highest start where you are, it's always less gfinish
          (if (fx< k top)
            ;; start at every lower cursor level with the result of the level above
            (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
          ;; advance cursor horizontally
          (cursor-moveto! sls k gfinish)))
      ;(snode-item (cursor-ref sls 0)))
      (sl-search! sls (snode-item (cursor-ref sls 0)))
      (sl-found sls))))

(define (skiplist->list sls . level)
  (let ((k (optional level 0)))
    (cursor-start! sls k)
    (let loop ((node (cursor-ref sls k)) (result '()))
      (if (snode-finish? node)
        (reverse result)
        (loop (snode-next-ref node k) (cons (snode-item node) result))))))

(define skiplists
  (let ((als '(
    (skiplists
      procedure:
      (skiplists)
      (skiplists sym)
      "documentation procedure."
      "The first call shows the list of exported symbols,"
      "the second documentation of symbol sym.")
    (skiplist
      procedure:
      (skiplist width max-height item? order . orders)
      (skiplist max-height item? order . orders)
      (skiplist item? order . orders)
      "constructors:"
      "width is the jump width,"
      "max-height the maximum allowed length of pointers of an item,"
      "item? checks items")
    (skiplist?
      procedure:
      (skiplist? xpr)
      "type predicate.")
    (skiplist->list
      procedure:
      (skiplist->list sls)
      (skiplist->list sls level)
      "the list of items stored in each level")
    (sl-null?
      procedure:
      (sl-null? sls)
      "is skiplist empty?")
    (sl-dups?
      procedure:
      (sl-dups? sls)
      "are duplicates allowed?")
    (sl-item?
      procedure:
      (sl-item? sls)
      "item type predicate")
    (dups
      procedure:
      (dups x y)
      "trivial numerical comparison operator to be used"
      "as last order to allow duplicates")
    (sl-compare
      procedure:
      (sl-compare sls)
      "combined comparison function")
    (sl-count
      procedure:
      (sl-count sls)
      "number of items stored in skiplist")
    (sl-found
      procedure:
      (sl-found sls)
      "list of found items, to be called after search!")
    (sl-found?
      procedure:
      (sl-found? sls item)
      "is item found?")
    (sl-height
      procedure:
      (sl-height sls)
      "actual maximal height of nodes (can be changed)")
    (sl-max-height
      procedure:
      (sl-max-height sls)
      "absolute maximum heigth of nodes in skiplist (not changeble)")
    (sl-max
      procedure:
      (sl-max sls)
      "biggest item stored in skiplist")
    (sl-min
      procedure:
      (sl-min sls)
      "smallest item stored in skiplist")
    (sl-orders
      procedure:
      (sl-orders sls)
      "list of orders defined in the constructor")
    (sl-search-level
      procedure:
      (sl-search-level sls)
      "down to which level a previous search descended?")
    (sl-width
      procedure:
      (sl-width sls)
      "width skipped on average at each search level supplied by constructor")
    (sl-map
      procedure:
      (sl-map fn sls)
      (sl-map fn sls order . orders)
      (sl-map fn sls width)
      (sl-map fn sls width order . orders)
      "depending on the mapping function, different order"
      "procedures might be necessary")
    (sl-for-each
      procedure:
      (sl-for-each proc sls)
      "apply proc to each item in skiplist")
    (sl-filter
      procedure:
      (sl-filter ok? sls)
      "filtering")
    (sl-reorder
      procedure:
      (sl-reorder sls order . orders)
      "changing orders")
    (sl-restructure
      procedure:
      (sl-restructure sls width max-height)
      "changing width")
    (sl-insert!
      procedure:
      (sl-insert! sls item . items)
      "insert new items into skiplist")
    (sl-remove!
      procedure:
      (sl-remove! sls item . items)
      "remove items from skiplist")
    (sl-search!
      procedure:
      (sl-search! sls item)
      "searching for an item changes internal cursor transparently")
    (sl-clear!
      procedure:
      (sl-clear! sls)
      "reset skiplist")
    )))
    (case-lambda
      (()
       (map car als))
      ((sym)
       (let ((pair (assq sym als)))
         (if pair
           (for-each print (cdr pair))
           (error "Not in list"
                  sym
                  (map car als))))))))

) ; module %skiplists

(module skiplists
  (skiplist skiplist? skiplist->list sl-null?
            sl-item? sl-found?
            sl-dups? sl-insert! sl-remove!
            sl-clear! sl-search! sl-orders
            sl-compare sl-width sl-height
            sl-found sl-filter sl-map
            sl-for-each sl-reorder sl-restructure
            sl-count sl-search-level sl-min
            sl-max sl-max-height dups) 


(import scheme
        (only (chicken base)
              case-lambda error cut fixnum? list-of? constantly)
        (only (chicken fixnum) fx+ fx- fx>= fx> fx< fx<= fx=)
        (only (chicken module) reexport)
        (prefix (except %skiplists dups skiplists) %))

(reexport (only %skiplists dups skiplists))

(define-syntax << ; internal (to avoid importing checks)
  (syntax-rules ()
    ((_ var)
     var)
    ((_ var ok?)
     (if (ok? var)
       var
       (error "test failed" ok?)))
    ((_ var ok? ok1? ...)
     (if (ok? var)
       (<< var ok1? ...)
       (error "test failed" ok?)))
    ))

;;; constructor
(define skiplist
  (case-lambda
    ((width max-height item? order . orders)
     (apply %skiplist
            (<< width fixnum? (cut fx> <> 1))
            (<< max-height fixnum? (cut fx> <> 1))
            (<< item? procedure?)
            (<< order procedure?)
            (<< orders (list-of? procedure?))))
    ((max-height item? order . orders)
     (apply skiplist 2 max-height item? order orders))
    ((item? order . orders)
     (apply skiplist 2 10 item? order orders))))

;;; predicates
(define skiplist? %skiplist?)

;; the list of items stored in each level
(define skiplist->list
  (case-lambda
    ((sls)
     (%skiplist->list (<< sls %skiplist?)))
    ((sls level)
     (%skiplist->list (<< sls %skiplist?)
                (<< level fixnum?
                          (cut fx<= 0 <>)
                          (cut fx< <> (%sl-height sls)))))
    ))

;; is skiplist empty?
(define (sl-null? sls)
  (%sl-null? (<< sls %skiplist?)))

;; are duplicates allowed?
(define (sl-dups? sls)
  (%sl-dups? (<< sls %skiplist?)))

;; item type predicate
(define (sl-item? sls)
  (%sl-item? (<< sls %skiplist?)))

;; item found?
(define (sl-found? sls item)
  (%sl-found? (<< sls %skiplist?)
              (<< item (%sl-item? sls))))

;;; functions

;; list of found items, to be called after search!
(define (sl-found sls)
  (%sl-found (<< sls %skiplist?)))

;; smallest item stored in skiplist
(define (sl-min sls)
  (%sl-min (<< sls %skiplist?)))

;; biggest item stored in skiplist
(define (sl-max sls)
  (%sl-max (<< sls %skiplist?)))

;; actual height of nodes (can be changed)
(define (sl-height sls)
  (%sl-height (<< sls %skiplist?)))

;; absolute maximum heigth of nodes in skiplist (not changeble)
(define (sl-max-height sls)
  (%sl-max-height (<< sls %skiplist?)))

;; width skipped on average at each search level supplied by constructor
(define (sl-width sls)
  (%sl-width (<< sls %skiplist?)))

;; number of items stored in skiplist
(define (sl-count sls)
  (%sl-count (<< sls %skiplist?)))

;; list of orders defined in the constructor
(define (sl-orders sls)
  (%sl-orders (<< sls %skiplist?)))

;; combined comparison function
(define (sl-compare sls)
  (%sl-compare (<< sls %skiplist?)))
  
;; down to which level a previous search descended?
(define (sl-search-level sls)
  (%sl-search-level (<< sls %skiplist?)))

;; filtering
(define (sl-filter ok? sls)
  (%sl-filter (<< ok? procedure?)
              (<< sls %skiplist?)))

;; mapping: depending on the mapping function, different order
;; procedures might be necessary
(define sl-map
  (case-lambda
    ((fn sls)
     (%sl-map (<< fn procedure?)
              (<< sls %skiplist?)))
    ((fn sls width)
     (%sl-map (<< fn procedure?)
              (<< sls %skiplist?)
              (<< width fixnum? (cut fx> <> 1))))
    ((fn sls order . orders)
     (apply %sl-map
            (<< fn procedure?)
            (<< sls %skiplist?)
            (<< order procedure?)
            (<< orders (list-of? procedure?))))
    ((fn sls width order . orders)
     (apply %sl-map
            (<< fn procedure?)
            (<< sls %skiplist?)
            (<< width fixnum? (cut fx> <> 1))
            (<< order procedure?)
            (<< orders (list-of? procedure?))))
   ))

;; apply proc to each item in skiplist
(define (sl-for-each proc sls)
  (%sl-for-each (<< proc procedure?)
                (<< sls %skiplist?)))


;; changing orders
(define (sl-reorder sls order . orders)
  (apply %sl-reorder
         (<< sls %skiplist?)
         (<< order procedure?)
         (<< orders (list-of? procedure?))))

;; changing width
(define (sl-restructure sls width max-height)
  (%sl-restructure (<< sls %skiplist?)
                   (<< width fixnum? (cut fx> <> 1))
                   (<< max-height fixnum? (cut fx> <> 1))))

;;; commands

;; searching for an item changes cursor transparently
(define (sl-search! sls item)
  (%sl-search! (<< sls %skiplist?)
               (<< item (%sl-item? sls))))

;; insert items into skiplist
(define (sl-insert! sls item . items)
  (apply %sl-insert!
         (<< sls %skiplist?)
         (<< item (%sl-item? sls))
         (<< items (list-of? (%sl-item? sls)))))

;; remove items from skiplist
(define (sl-remove! sls item . items)
  (apply %sl-remove!
         (<< sls %skiplist?)
         (<< item (%sl-item? sls))
         (<< items (list-of? (%sl-item? sls)))))

;; reset skiplist
(define (sl-clear! sls)
  (%sl-clear! (<< sls %skiplist?)))

) ; module skiplists