Changeset 34042 in project


Ignore:
Timestamp:
04/30/17 17:51:06 (3 years ago)
Author:
juergen
Message:

skiplists 1.1.5 adds missing skiplist-max-height

Location:
release/4/skiplists
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/skiplists/tags/1.1.5/skiplists.scm

    r30430 r34042  
    3232;         ju (at) jugilo (dot) de
    3333;
    34 ; Last update: Apr 19, 2013
     34; Last update: Mar 12, 2013
    3535;
    3636;Rationale
     
    8888  (only chicken
    8989        define-record-type define-record-printer optional when unless
    90         define-inline error void fixnum?
     90        condition-case case-lambda void
    9191        fx+ fx- fx>= fx> fx< fx= fxmin gensym vector-resize getter-with-setter)
    9292  (only data-structures identity list-of?)
     
    102102           (loop)))))))
    103103
    104 (define-inline (fx1- n) (fx- n 1))
    105 (define-inline (fx1+ n) (fx+ n 1))
    106 
    107 (define (repeat-string str k)
    108   (let loop ((k k) (result ""))
    109     (if (fx= k 0)
    110       result
    111       (loop (fx1- k) (string-append str result)))))
    112 
    113 (define (choose-height width)
    114   (let loop ((choice (random width)) (k 1))
    115     (if (fx>= choice 1)
    116       k
    117       (loop (random width) (fx1+ k)))))
    118 
    119104;; trivial comparison operator to allow duplicates
    120105;; must be the last order in the orders list
    121106(define (dups x y)
    122107  0)
    123 ;;;; skipnode ADT (hidden)
    124 
    125 (define-record-type skipnode
    126   (make-skipnode item next)
    127   skipnode?
    128   (item skipnode-item)
    129   (next skipnode-next))
     108;;;; snode ADT (hidden)
     109
     110(define-record-type snode
     111  (make-snode item next)
     112  snode?
     113  (item snode-item)
     114  (next snode-next))
    130115
    131116;;; constructor
    132 (define-inline (skipnode item height)
    133   (make-skipnode item (make-vector height '())))
    134 
    135 ;; items of the first and last skipnode
     117(define (snode item height)
     118  (make-snode item (make-vector height '())))
     119
     120;; items of the first and last snode
    136121(define gstart (gensym 'start))
    137122(define gfinish (gensym 'finish))
    138123
    139 (define-inline (skipnode-finish? node)
    140   (eq? (skipnode-item node) gfinish))
    141 
    142 (define-inline (skipnode-start? node)
    143   (eq? (skipnode-item node) gstart))
    144 
    145 (define skipnode-next-ref
     124(define (snode-finish? node)
     125  (eq? (snode-item node) gfinish))
     126
     127(define (snode-start? node)
     128  (eq? (snode-item node) gstart))
     129
     130(define snode-next-ref
    146131  (getter-with-setter
    147132    (lambda (node k)
    148       (vector-ref (skipnode-next node) k))
     133      (vector-ref (snode-next node) k))
    149134    (lambda (node k new)
    150       (vector-set! (skipnode-next node) k new))))
    151 
    152 (define-inline (skipnode-height node)
    153   (vector-length (skipnode-next node)))
    154 
    155 (define-record-printer (skipnode node out)
     135      (vector-set! (snode-next node) k new))))
     136
     137(define-record-printer (snode node out)
    156138  (format out "~S#~S"
    157           (skipnode-item node) (skipnode-height node)))
     139          (snode-item node) (snode-height node)))
     140
     141(define (snode-height node)
     142  (vector-length (snode-next node)))
    158143
    159144(define-record-type skiplist
    160   (make-skiplist width item? orders height count start cursor found level finish)
     145  (make-skiplist width max-height item? orders height count start cursor found level finish)
    161146  skiplist?
    162147  (width skiplist-width)
     148  (max-height skiplist-max-height)
    163149  (item? skiplist-item?)
    164150  (orders skiplist-orders)
     
    166152  (height skiplist-height skiplist-height-set!)
    167153  (count skiplist-count skiplist-count-set!)
    168   (start skiplist-start (setter skiplist-start)) ; vector of max-height
     154  (start skiplist-start (setter skiplist-start))
    169155  (cursor skiplist-cursor (setter skiplist-cursor)) ; vector of nodes
    170156  (found skiplist-found skiplist-found-set!)
    171157  (level skiplist-search-level skiplist-search-level-set!)
    172158  (finish skiplist-finish (setter skiplist-finish)))
     159
     160(define (repeat-string str k)
     161  (let loop ((k k) (result ""))
     162    (if (zero? k)
     163      result
     164      (loop (fx- k 1) (string-append str result)))))
    173165
    174166(define-record-printer (skiplist sls out)
     
    186178              (repeat-string " ~s" (length smax)) smax))))
    187179
    188 ;; check constructor arguments (internal)
    189 (define (width-and-max-height? ls)
    190   (and (list? ls)
    191        (fx> (length ls) 3)
    192        (let ((width (car ls))
    193              (max-height (cadr ls))
    194              (item? (caddr ls))
    195              (orders (cdddr ls)))
    196          (fixnum? width)
    197          (fx> width 1)
    198          (fixnum? max-height)
    199          (fx> max-height 1)
    200          (procedure? item?)
    201          ((list-of? procedure?) orders))))
    202 
    203 (define (max-height? ls)
    204   (and (list? ls)
    205        (fx> (length ls) 2)
    206        (let ((max-height (car ls))
    207              (item? (cadr ls))
    208              (orders (cddr ls)))
    209          (fixnum? max-height)
    210          (fx> max-height 1)
    211          (procedure? item?)
    212          ((list-of? procedure?) orders))))
    213 
    214180;; constructor
    215 (define (skiplist . args)
    216   (cond
    217     ;; width and max-height supplied
    218     ((width-and-max-height? args)
    219      (let* ((max-height (cadr args))
    220             (finish (skipnode gfinish max-height))
    221             (start (make-skipnode gstart (make-vector max-height finish))))
    222        (make-skiplist (car args) ; width
    223                       (caddr args) ; item?
    224                       (cdddr args) ; orders
     181;(define (skiplist width item? order . orders)
     182;  (let ((start (snode gstart 1)) (finish (snode gfinish 1)))
     183;    (set! (snode-next-ref start 0) finish)
     184;    (make-skiplist width
     185;                   item?
     186;                   (cons order orders)
     187;                   1
     188;                   0
     189;                   start
     190;                   (vector start)
     191;                   '() ; found
     192;                   0 ; level
     193;                   finish)))
     194(define skiplist
     195  (case-lambda
     196    ((width max-height item? order . orders)
     197     (let* ((finish (snode gfinish max-height))
     198            (start (make-snode gstart (make-vector max-height finish))))
     199       (make-skiplist width
     200                      max-height
     201                      item?
     202                      (cons order orders)
    225203                      1 ; height
    226204                      0 ; count
     
    230208                      0 ; level
    231209                      finish)))
    232     ;; default value for width
    233     ((max-height? args)
    234      (let* ((max-height (car args))
    235             (finish (skipnode gfinish max-height))
    236             (start (make-skipnode gstart (make-vector max-height finish))))
    237        (make-skiplist 2 ; width
    238                       (cadr args) ; item?
    239                       (cddr args) ; orders
    240                       1 ; height
    241                       0 ; count
    242                       start
    243                       (vector start) ; cursor
    244                       '() ; found
    245                       0 ; level
    246                       finish)))
    247     ;; default values for width and max-height
    248     ((and (fx> (length args) 1) ((list-of? procedure?) args))
    249      (let* ((max-height 10)
    250             (finish (skipnode gfinish max-height))
    251             (start (make-skipnode gstart (make-vector max-height finish))))
    252        (make-skiplist 2 ; width
    253                       (car args) ; item?
    254                       (cdr args) ; (cons order orders)
    255                       1 ; height
    256                       0 ; count
    257                       start
    258                       (vector start) ; cursor
    259                       '() ; found
    260                       0 ; level
    261                       finish)))
    262     (else (error 'skiplist "no constructor arguments" args))))
    263 
    264 (define (skiplist-max-height sls)
    265   (vector-length (skipnode-next (skiplist-start sls))))
     210    ((max-height item? order . orders)
     211     (apply skiplist 2 max-height item? order orders))
     212    ((item? order . orders)
     213     (apply skiplist 2 10 item? order orders))))
     214
    266215
    267216(define (skiplist-dups? sls)
     
    304253
    305254(define (cursor-less? sls k item)
    306   (skiplist-less? sls (skipnode-item (cursor-next sls k)) item))
     255  (skiplist-less? sls (snode-item (cursor-next sls k)) item))
    307256
    308257(define (cursor-equal? sls k item)
    309   (skiplist-equal? sls (skipnode-item (cursor-next sls k)) item))
     258  (skiplist-equal? sls (snode-item (cursor-next sls k)) item))
    310259
    311260;; all operations should happen at the cursor, where it is moved in such
     
    322271  (getter-with-setter
    323272    (lambda (sls k)
    324       (skipnode-next-ref (cursor-ref sls k) k))
     273      (snode-next-ref (cursor-ref sls k) k))
    325274    (lambda (sls k new)
    326       (set! (skipnode-next-ref (cursor-ref sls k) k) new))))
     275      (set! (snode-next-ref (cursor-ref sls k) k) new))))
    327276
    328277(define skiplist-start-next
    329278  (getter-with-setter
    330279    (lambda (sls k)
    331       (skipnode-next-ref (skiplist-start sls) k))
     280      (snode-next-ref (skiplist-start sls) k))
    332281    (lambda (sls k node)
    333       (set! (skipnode-next-ref (skiplist-start sls) k) node))))
     282      (set! (snode-next-ref (skiplist-start sls) k) node))))
    334283
    335284;; cursor movements
     
    347296
    348297;;; this is where the work gets done!
     298;;; it's only needed in skiplist-max, but a pattern for skiplist-search!
     299;(define (cursor-prepare! sls item)
     300;  (let* ((height (skiplist-height sls)) (top (fx- height 1)))
     301;    ;; save cursors at every level
     302;    (do ((k top (fx- k 1)))
     303;      ((negative? k))
     304;      (if (fx= k top)
     305;        ;;; restart cursor at highest level only if cursor not less item
     306;        (if (not (cursor-less? sls k item))
     307;          (set! (cursor-ref sls k) (skiplist-start sls)))
     308;        ;; start at every lower cursor level with the result of the level above
     309;        (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
     310;      ;; advance cursor horizontally
     311;      (cursor-moveto! sls k item))))
     312
     313;; the same as cursor-prepare!, but stops earlier, if item found
     314;; and collects found items
    349315(define (skiplist-search! sls item)
    350316  (call-with-current-continuation
    351317    (lambda (out)
    352       (let ((top (fx1- (skiplist-height sls))))
     318      (let ((top (fx- (skiplist-height sls) 1)))
    353319        ;; save cursors at every level
    354         (do ((k top (fx1- k)))
     320        (do ((k top (fx- k 1)))
    355321          ((negative? k))
    356322          (if (fx= k top)
     
    359325              (set! (cursor-ref sls k) (skiplist-start sls)))
    360326            ;; start at every lower cursor level with the result of the level above
    361             (set! (cursor-ref sls k) (cursor-ref sls (fx1+ k))))
     327            (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
    362328          ;; advance cursor horizontally
    363329          (cursor-moveto! sls k item)
     
    367333              ;; collect found items
    368334              (let loop ((node (cursor-next sls k)) (found '()))
    369                 (if (not (skiplist-equal? sls (skipnode-item node) item))
     335                (if (not (skiplist-equal? sls (snode-item node) item))
    370336                  (skiplist-found-set! sls (reverse found))
    371                   (loop (skipnode-next-ref node k)
    372                         (cons (skipnode-item node) found))))
     337                  (loop (snode-next-ref node k)
     338                        (cons (snode-item node) found))))
    373339              (out (void)))
    374340            (begin
     
    376342              (skiplist-search-level-set! sls k))))))))
    377343
    378 (define (skiplist-search-further! sls item)
     344(define (skiplist-search-continue! sls item)
    379345  ;; save cursors at every level below search level
    380   (do ((k (fx1- (skiplist-search-level sls)) (fx1- k)))
     346  (do ((k (fx- (skiplist-search-level sls) 1) (fx- k 1)))
    381347    ((negative? k))
    382348      ;; restart cursor at every lower cursor level with the result of the level above
    383     (set! (cursor-ref sls k) (cursor-ref sls (fx1+ k)))
     349    (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1)))
    384350    ;; advance cursor horizontally
    385351    (cursor-moveto! sls k item)))
     352
     353(define (choose-height width)
     354  (let loop ((choice (random width)) (k 1))
     355    (if (fx>= choice 1)
     356      k
     357      (loop (random width) (fx+ k 1)))))
    386358
    387359(define (skiplist-insert! sls item . items)
     
    390362    ;; restructure
    391363    (when (> height (skiplist-height sls))
     364      ;(set! (skiplist-finish sls) (snode gfinish height))
     365      ;(set! (skiplist-start sls)
     366      ;      (make-snode gstart
     367      ;                  (vector-resize (snode-next (skiplist-start sls))
     368      ;                                 height
     369      ;                                 (skiplist-finish sls))))
    392370      (set! (skiplist-cursor sls)
    393371            (vector-resize (skiplist-cursor sls)
     
    406384          (height (if (null? (skiplist-found sls))
    407385                    height
    408                     (skipnode-height
     386                    (snode-height
    409387                      (cursor-next sls (skiplist-search-level sls)))))
    410           (new (skipnode item height))
     388          (new (snode item height))
    411389          )
    412390          ;; prepare lower part of cursor for insertion
    413           (skiplist-search-further! sls item)
    414           (skiplist-count-set! sls (fx1+ (skiplist-count sls)))
     391          (skiplist-search-continue! sls item)
     392          (skiplist-count-set! sls (fx+ (skiplist-count sls) 1))
    415393          (skiplist-found-set! sls (cons item (skiplist-found sls)))
    416           (do ((k 0 (fx1+ k)))
     394          (do ((k 0 (fx+ k 1)))
    417395            ((fx= k height))
    418             (set! (skipnode-next-ref new k)
     396            (set! (snode-next-ref new k)
    419397                  (cursor-next sls k))
    420398            (set! (cursor-next sls k) new))))
     
    424402        (when (null? (skiplist-found sls))
    425403          ;; prepare lower part of cursor
    426           (skiplist-search-further! sls item)
    427           (let ((new (skipnode item height)))
    428             (skiplist-count-set! sls (fx1+ (skiplist-count sls)))
    429             (do ((k 0 (fx1+ k)))
     404          (skiplist-search-continue! sls item)
     405          (let ((new (snode item height)))
     406            (skiplist-count-set! sls (fx+ (skiplist-count sls) 1))
     407            (do ((k 0 (fx+ k 1)))
    430408              ((fx= k height))
    431               (set! (skipnode-next-ref new k)
     409              (set! (snode-next-ref new k)
    432410                    (cursor-next sls k))
    433411              (set! (cursor-next sls k) new)))))))
     
    446424        (do-while
    447425          (not (equal? item
    448                        (skipnode-item (cursor-next sls level))))
     426                       (snode-item (cursor-next sls level))))
    449427          (cursor-forth! sls level))
    450         (skiplist-search-further! sls item)
     428        (skiplist-search-continue! sls item)
    451429        (when (cursor-equal? sls level item)
    452430          (set! (cursor-next sls level)
    453                 (skipnode-next-ref (cursor-next sls level) level))
    454           (skiplist-count-set! sls (fx1- (skiplist-count sls)))
     431                (snode-next-ref (cursor-next sls level) level))
     432          (skiplist-count-set! sls (fx- (skiplist-count sls) 1))
    455433          (skiplist-found-set! sls (cdr (skiplist-found sls)))
    456           (do ((k 0 (fx1+ k)))
     434          (do ((k 0 (fx+ k 1)))
    457435            ((fx= k level))
    458436            (when (cursor-equal? sls k item)
    459437              (set! (cursor-next sls k)
    460                     (skipnode-next-ref (cursor-next sls k) k))))))))
     438                    (snode-next-ref (cursor-next sls k) k))))))))
    461439  ;; remove other items, if any
    462440  (do ((items items (cdr items)))
     
    465443
    466444(define (skiplist-for-each sls proc)
    467   (do ((node (skipnode-next-ref (skiplist-start sls) 0)
    468              (skipnode-next-ref node 0)))
    469     ((skipnode-finish? node)) ; way out
    470     (proc (skipnode-item node))))
     445  (do ((node (snode-next-ref (skiplist-start sls) 0)
     446             (snode-next-ref node 0)))
     447    ((snode-finish? node)) ; way out
     448    (proc (snode-item node))))
    471449
    472450(define (skiplist-clear! sls)
    473451  (skiplist-height-set! sls 1)
    474   (do ((k 0 (fx1+ k)))
    475     ((fx= k (skiplist-max-height sls)))
    476     (set! (skiplist-start-next sls k) (skiplist-finish sls)))
     452  (set! (skiplist-finish sls) (snode gfinish 1))
     453  (set! (skiplist-start sls) (snode gstart 1))
     454  (set! (skiplist-start-next sls 0) (skiplist-finish sls))
    477455  (set! (skiplist-cursor sls) (make-vector 1 (skiplist-start sls)))
    478456  (skiplist-count-set! sls 0))
    479457
    480 (define (skiplist-map sls proc . args)
     458(define (skiplist-map sls proc . target-structure)
    481459  (let (
    482460    (result
    483461      (cond
    484         ;; old width, max-height, item? and orders
    485         ((null? args)
    486          (apply skiplist
    487                 (skiplist-width sls)
    488                 (skiplist-max-height sls)
    489                 (skiplist-item? sls)
    490                 (skiplist-orders sls)))
    491         ;; old width and max-height,  new item? and orders
    492         ((and (fx> (length args) 1)
    493               ((list-of? procedure?) args))
    494          (apply skiplist
    495                 (skiplist-width sls)
    496                 (skiplist-max-height sls)
    497                 args))))
     462        ;; old width and orders
     463        ((null? target-structure)
     464         (apply skiplist (skiplist-width sls) (skiplist-item? sls) (skiplist-orders sls)))
     465        ;; old width, new item? and orders
     466        (((list-of? procedure?) target-structure)
     467         (apply skiplist (skiplist-width sls) target-structure))
     468        ;; new width, old item? and orders
     469        ((null? (cdr target-structure))
     470         (apply skiplist (car target-structure) (skiplist-item? sls) (skiplist-orders sls)))
     471        ;; new width, new item? and orders
     472        (else
     473          (apply skiplist target-structure))))
    498474    )
    499     (do ((node (skipnode-next-ref (skiplist-start sls) 0)
    500                (skipnode-next-ref node 0)))
    501       ((skipnode-finish? node)) ; way out
    502       (skiplist-insert! result (proc (skipnode-item node))))
     475    (do ((node (snode-next-ref (skiplist-start sls) 0)
     476               (snode-next-ref node 0)))
     477      ((snode-finish? node)) ; way out
     478      (skiplist-insert! result (proc (snode-item node))))
    503479    result))
    504480
    505481(define (skiplist-restructure sls width max-height)
     482  ;(skiplist-map sls identity width))
    506483  (let ((result (apply skiplist
    507484                       width
     
    509486                       (skiplist-item? sls)
    510487                       (skiplist-orders sls))))
    511     (do ((node (skipnode-next-ref (skiplist-start sls) 0) (skipnode-next-ref node 0)))
    512       ((skipnode-finish? node))
    513       (skiplist-insert! result (skipnode-item node)))
     488    (do ((node (snode-next-ref (skiplist-start sls) 0) (snode-next-ref node 0)))
     489      ((snode-finish? node))
     490      (skiplist-insert! result (snode-item node)))
    514491    result))
    515492
     
    521498                       (skiplist-item?  sls)
    522499                       order orders)))
    523     (do ((node (skipnode-next-ref (skiplist-start sls) 0) (skipnode-next-ref node 0)))
    524       ((skipnode-finish? node))
    525       (skiplist-insert! result (skipnode-item node)))
     500    (do ((node (snode-next-ref (skiplist-start sls) 0) (snode-next-ref node 0)))
     501      ((snode-finish? node))
     502      (skiplist-insert! result (snode-item node)))
    526503    result))
    527504
     
    532509                       (skiplist-item?  sls)
    533510                       (skiplist-orders sls))))
    534     (do ((node (skipnode-next-ref (skiplist-start sls) 0)
    535                (skipnode-next-ref node 0)))
    536       ((skipnode-finish? node)) ; way out
    537       (let ((item (skipnode-item node)))
     511    (do ((node (snode-next-ref (skiplist-start sls) 0)
     512               (snode-next-ref node 0)))
     513      ((snode-finish? node)) ; way out
     514      (let ((item (snode-item node)))
    538515        (if (ok? item) (skiplist-insert! result item))))
    539516    result))
     
    544521    (begin
    545522      (cursor-start! sls 0)
    546       ;(skipnode-item (cursor-ref sls 0)))
    547       (skiplist-search! sls (skipnode-item (cursor-ref sls 0)))
     523      ;(snode-item (cursor-ref sls 0)))
     524      (skiplist-search! sls (snode-item (cursor-ref sls 0)))
    548525      (skiplist-found sls))))
    549   ;(let ((item (skipnode-item (cursor-ref sls 0))))
     526  ;(let ((item (snode-item (cursor-ref sls 0))))
    550527  ;  (if (skiplist-dups? sls)
    551528  ;    (begin
     
    561538    '()
    562539    (begin
    563       (let ((top (fx1- (skiplist-height sls))))
     540      (let ((top (fx- (skiplist-height sls) 1)))
    564541        ;; save cursors at every level
    565         (do ((k top (fx1- k)))
     542        (do ((k top (fx- k 1)))
    566543          ((negative? k))
    567544          ;; at highest start where you are, it's always less gfinish
    568545          (if (fx< k top)
    569546            ;; start at every lower cursor level with the result of the level above
    570             (set! (cursor-ref sls k) (cursor-ref sls (fx1+ k))))
     547            (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
    571548          ;; advance cursor horizontally
    572549          (cursor-moveto! sls k gfinish)))
    573       ;(skipnode-item (cursor-ref sls 0)))
    574       (skiplist-search! sls (skipnode-item (cursor-ref sls 0)))
     550      ;(snode-item (cursor-ref sls 0)))
     551      (skiplist-search! sls (snode-item (cursor-ref sls 0)))
    575552      (skiplist-found sls))))
    576553
     
    579556    (cursor-start! sls k)
    580557    (let loop ((node (cursor-ref sls k)) (result '()))
    581       (if (skipnode-finish? node)
     558      (if (snode-finish? node)
    582559        (reverse result)
    583         (loop (skipnode-next-ref node k) (cons (skipnode-item node) result))))))
     560        (loop (snode-next-ref node k) (cons (snode-item node) result))))))
    584561
    585562) ; module %skiplists
     
    592569        dbc
    593570        (only chicken cut
    594               fixnum? fx>= fx> fx< fx<= fx=)
     571              fixnum? fx+ fx- fx>= fx> fx< fx<= fx=)
    595572        ; get-output-string open-output-string)
    596573        (only data-structures list-of? constantly)
     
    614591          "like order, last one might be dups")
    615592     (%skiplist? result))
    616     ((_ max-height item? order . orders)
    617      (and (fixnum? max-height) (fx> max-height 1)
     593    ((_ width item? order . orders)
     594     (and (fixnum? width) (fx> width 1)
    618595          (procedure? item?) "(item? item)"
    619596          (procedure? order) "(fixnum? (order item? item?))"
     
    705682  %skiplist-max)
    706683
     684(define-with-contract skiplist-max-height ;;new
     685  (contract (result)
     686    ((_ sls)
     687     (%skiplist? sls)
     688     (and (fixnum? result) (fx> result 0))))
     689  %skiplist-max-height)
    707690
    708691;; maximum heigth of nodes in skiplist
     
    721704     (and (fixnum? result) (fx> result 1))))
    722705  %skiplist-width)
    723 
    724 ;; maximal height
    725 (define-with-contract skiplist-max-height
    726   (contract (result)
    727     ((_ sls)
    728      (%skiplist? sls)
    729      (and (fixnum? result) (fx> result 1))))
    730   %skiplist-max-height)
    731706
    732707;; number of items stored in skiplist
     
    790765     (and (%skiplist? sls) (procedure? fn) "((skiplist-item? sls) (fn x))")
    791766     (%skiplist? result))
    792     ((_ sls fn order . orders) ;;;
     767    ((_ sls fn order . orders)
    793768     (and (%skiplist? sls) (procedure? fn)
    794           ((list-of? procedure?) (cons order orders)))
     769          (((list-of? procedure?) (cons order orders))))
    795770     (%skiplist? result))
    796771    ((_ sls fn width)
     
    798773          (procedure? fn) "((skiplist-item? sls) (fn x))")
    799774     (%skiplist? result))
    800     ((_ sls fn width order . orders) ;;;
     775    ((_ sls fn width order . orders)
    801776     (and (%skiplist? sls) (procedure? fn)
    802777          (fixnum? width) (fx> width 1)
    803           ((list-of? procedure?) (cons order orders)))
    804      (%skiplist? result))
    805     )
     778          (((list-of? procedure?) (cons order orders))))
     779     (%skiplist? result)))
    806780  %skiplist-map)
    807781
  • release/4/skiplists/tags/1.1.5/skiplists.setup

    r30430 r34042  
    88 'skiplists
    99 '("skiplists.so" "%skiplists.import.so" "skiplists.import.so")
    10  '((version "1.1.4")))
     10 '((version "1.1.5")))
  • release/4/skiplists/trunk/skiplists.scm

    r30430 r34042  
    3232;         ju (at) jugilo (dot) de
    3333;
    34 ; Last update: Apr 19, 2013
     34; Last update: Mar 12, 2013
    3535;
    3636;Rationale
     
    8888  (only chicken
    8989        define-record-type define-record-printer optional when unless
    90         define-inline error void fixnum?
     90        condition-case case-lambda void
    9191        fx+ fx- fx>= fx> fx< fx= fxmin gensym vector-resize getter-with-setter)
    9292  (only data-structures identity list-of?)
     
    102102           (loop)))))))
    103103
    104 (define-inline (fx1- n) (fx- n 1))
    105 (define-inline (fx1+ n) (fx+ n 1))
    106 
    107 (define (repeat-string str k)
    108   (let loop ((k k) (result ""))
    109     (if (fx= k 0)
    110       result
    111       (loop (fx1- k) (string-append str result)))))
    112 
    113 (define (choose-height width)
    114   (let loop ((choice (random width)) (k 1))
    115     (if (fx>= choice 1)
    116       k
    117       (loop (random width) (fx1+ k)))))
    118 
    119104;; trivial comparison operator to allow duplicates
    120105;; must be the last order in the orders list
    121106(define (dups x y)
    122107  0)
    123 ;;;; skipnode ADT (hidden)
    124 
    125 (define-record-type skipnode
    126   (make-skipnode item next)
    127   skipnode?
    128   (item skipnode-item)
    129   (next skipnode-next))
     108;;;; snode ADT (hidden)
     109
     110(define-record-type snode
     111  (make-snode item next)
     112  snode?
     113  (item snode-item)
     114  (next snode-next))
    130115
    131116;;; constructor
    132 (define-inline (skipnode item height)
    133   (make-skipnode item (make-vector height '())))
    134 
    135 ;; items of the first and last skipnode
     117(define (snode item height)
     118  (make-snode item (make-vector height '())))
     119
     120;; items of the first and last snode
    136121(define gstart (gensym 'start))
    137122(define gfinish (gensym 'finish))
    138123
    139 (define-inline (skipnode-finish? node)
    140   (eq? (skipnode-item node) gfinish))
    141 
    142 (define-inline (skipnode-start? node)
    143   (eq? (skipnode-item node) gstart))
    144 
    145 (define skipnode-next-ref
     124(define (snode-finish? node)
     125  (eq? (snode-item node) gfinish))
     126
     127(define (snode-start? node)
     128  (eq? (snode-item node) gstart))
     129
     130(define snode-next-ref
    146131  (getter-with-setter
    147132    (lambda (node k)
    148       (vector-ref (skipnode-next node) k))
     133      (vector-ref (snode-next node) k))
    149134    (lambda (node k new)
    150       (vector-set! (skipnode-next node) k new))))
    151 
    152 (define-inline (skipnode-height node)
    153   (vector-length (skipnode-next node)))
    154 
    155 (define-record-printer (skipnode node out)
     135      (vector-set! (snode-next node) k new))))
     136
     137(define-record-printer (snode node out)
    156138  (format out "~S#~S"
    157           (skipnode-item node) (skipnode-height node)))
     139          (snode-item node) (snode-height node)))
     140
     141(define (snode-height node)
     142  (vector-length (snode-next node)))
    158143
    159144(define-record-type skiplist
    160   (make-skiplist width item? orders height count start cursor found level finish)
     145  (make-skiplist width max-height item? orders height count start cursor found level finish)
    161146  skiplist?
    162147  (width skiplist-width)
     148  (max-height skiplist-max-height)
    163149  (item? skiplist-item?)
    164150  (orders skiplist-orders)
     
    166152  (height skiplist-height skiplist-height-set!)
    167153  (count skiplist-count skiplist-count-set!)
    168   (start skiplist-start (setter skiplist-start)) ; vector of max-height
     154  (start skiplist-start (setter skiplist-start))
    169155  (cursor skiplist-cursor (setter skiplist-cursor)) ; vector of nodes
    170156  (found skiplist-found skiplist-found-set!)
    171157  (level skiplist-search-level skiplist-search-level-set!)
    172158  (finish skiplist-finish (setter skiplist-finish)))
     159
     160(define (repeat-string str k)
     161  (let loop ((k k) (result ""))
     162    (if (zero? k)
     163      result
     164      (loop (fx- k 1) (string-append str result)))))
    173165
    174166(define-record-printer (skiplist sls out)
     
    186178              (repeat-string " ~s" (length smax)) smax))))
    187179
    188 ;; check constructor arguments (internal)
    189 (define (width-and-max-height? ls)
    190   (and (list? ls)
    191        (fx> (length ls) 3)
    192        (let ((width (car ls))
    193              (max-height (cadr ls))
    194              (item? (caddr ls))
    195              (orders (cdddr ls)))
    196          (fixnum? width)
    197          (fx> width 1)
    198          (fixnum? max-height)
    199          (fx> max-height 1)
    200          (procedure? item?)
    201          ((list-of? procedure?) orders))))
    202 
    203 (define (max-height? ls)
    204   (and (list? ls)
    205        (fx> (length ls) 2)
    206        (let ((max-height (car ls))
    207              (item? (cadr ls))
    208              (orders (cddr ls)))
    209          (fixnum? max-height)
    210          (fx> max-height 1)
    211          (procedure? item?)
    212          ((list-of? procedure?) orders))))
    213 
    214180;; constructor
    215 (define (skiplist . args)
    216   (cond
    217     ;; width and max-height supplied
    218     ((width-and-max-height? args)
    219      (let* ((max-height (cadr args))
    220             (finish (skipnode gfinish max-height))
    221             (start (make-skipnode gstart (make-vector max-height finish))))
    222        (make-skiplist (car args) ; width
    223                       (caddr args) ; item?
    224                       (cdddr args) ; orders
     181;(define (skiplist width item? order . orders)
     182;  (let ((start (snode gstart 1)) (finish (snode gfinish 1)))
     183;    (set! (snode-next-ref start 0) finish)
     184;    (make-skiplist width
     185;                   item?
     186;                   (cons order orders)
     187;                   1
     188;                   0
     189;                   start
     190;                   (vector start)
     191;                   '() ; found
     192;                   0 ; level
     193;                   finish)))
     194(define skiplist
     195  (case-lambda
     196    ((width max-height item? order . orders)
     197     (let* ((finish (snode gfinish max-height))
     198            (start (make-snode gstart (make-vector max-height finish))))
     199       (make-skiplist width
     200                      max-height
     201                      item?
     202                      (cons order orders)
    225203                      1 ; height
    226204                      0 ; count
     
    230208                      0 ; level
    231209                      finish)))
    232     ;; default value for width
    233     ((max-height? args)
    234      (let* ((max-height (car args))
    235             (finish (skipnode gfinish max-height))
    236             (start (make-skipnode gstart (make-vector max-height finish))))
    237        (make-skiplist 2 ; width
    238                       (cadr args) ; item?
    239                       (cddr args) ; orders
    240                       1 ; height
    241                       0 ; count
    242                       start
    243                       (vector start) ; cursor
    244                       '() ; found
    245                       0 ; level
    246                       finish)))
    247     ;; default values for width and max-height
    248     ((and (fx> (length args) 1) ((list-of? procedure?) args))
    249      (let* ((max-height 10)
    250             (finish (skipnode gfinish max-height))
    251             (start (make-skipnode gstart (make-vector max-height finish))))
    252        (make-skiplist 2 ; width
    253                       (car args) ; item?
    254                       (cdr args) ; (cons order orders)
    255                       1 ; height
    256                       0 ; count
    257                       start
    258                       (vector start) ; cursor
    259                       '() ; found
    260                       0 ; level
    261                       finish)))
    262     (else (error 'skiplist "no constructor arguments" args))))
    263 
    264 (define (skiplist-max-height sls)
    265   (vector-length (skipnode-next (skiplist-start sls))))
     210    ((max-height item? order . orders)
     211     (apply skiplist 2 max-height item? order orders))
     212    ((item? order . orders)
     213     (apply skiplist 2 10 item? order orders))))
     214
    266215
    267216(define (skiplist-dups? sls)
     
    304253
    305254(define (cursor-less? sls k item)
    306   (skiplist-less? sls (skipnode-item (cursor-next sls k)) item))
     255  (skiplist-less? sls (snode-item (cursor-next sls k)) item))
    307256
    308257(define (cursor-equal? sls k item)
    309   (skiplist-equal? sls (skipnode-item (cursor-next sls k)) item))
     258  (skiplist-equal? sls (snode-item (cursor-next sls k)) item))
    310259
    311260;; all operations should happen at the cursor, where it is moved in such
     
    322271  (getter-with-setter
    323272    (lambda (sls k)
    324       (skipnode-next-ref (cursor-ref sls k) k))
     273      (snode-next-ref (cursor-ref sls k) k))
    325274    (lambda (sls k new)
    326       (set! (skipnode-next-ref (cursor-ref sls k) k) new))))
     275      (set! (snode-next-ref (cursor-ref sls k) k) new))))
    327276
    328277(define skiplist-start-next
    329278  (getter-with-setter
    330279    (lambda (sls k)
    331       (skipnode-next-ref (skiplist-start sls) k))
     280      (snode-next-ref (skiplist-start sls) k))
    332281    (lambda (sls k node)
    333       (set! (skipnode-next-ref (skiplist-start sls) k) node))))
     282      (set! (snode-next-ref (skiplist-start sls) k) node))))
    334283
    335284;; cursor movements
     
    347296
    348297;;; this is where the work gets done!
     298;;; it's only needed in skiplist-max, but a pattern for skiplist-search!
     299;(define (cursor-prepare! sls item)
     300;  (let* ((height (skiplist-height sls)) (top (fx- height 1)))
     301;    ;; save cursors at every level
     302;    (do ((k top (fx- k 1)))
     303;      ((negative? k))
     304;      (if (fx= k top)
     305;        ;;; restart cursor at highest level only if cursor not less item
     306;        (if (not (cursor-less? sls k item))
     307;          (set! (cursor-ref sls k) (skiplist-start sls)))
     308;        ;; start at every lower cursor level with the result of the level above
     309;        (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
     310;      ;; advance cursor horizontally
     311;      (cursor-moveto! sls k item))))
     312
     313;; the same as cursor-prepare!, but stops earlier, if item found
     314;; and collects found items
    349315(define (skiplist-search! sls item)
    350316  (call-with-current-continuation
    351317    (lambda (out)
    352       (let ((top (fx1- (skiplist-height sls))))
     318      (let ((top (fx- (skiplist-height sls) 1)))
    353319        ;; save cursors at every level
    354         (do ((k top (fx1- k)))
     320        (do ((k top (fx- k 1)))
    355321          ((negative? k))
    356322          (if (fx= k top)
     
    359325              (set! (cursor-ref sls k) (skiplist-start sls)))
    360326            ;; start at every lower cursor level with the result of the level above
    361             (set! (cursor-ref sls k) (cursor-ref sls (fx1+ k))))
     327            (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
    362328          ;; advance cursor horizontally
    363329          (cursor-moveto! sls k item)
     
    367333              ;; collect found items
    368334              (let loop ((node (cursor-next sls k)) (found '()))
    369                 (if (not (skiplist-equal? sls (skipnode-item node) item))
     335                (if (not (skiplist-equal? sls (snode-item node) item))
    370336                  (skiplist-found-set! sls (reverse found))
    371                   (loop (skipnode-next-ref node k)
    372                         (cons (skipnode-item node) found))))
     337                  (loop (snode-next-ref node k)
     338                        (cons (snode-item node) found))))
    373339              (out (void)))
    374340            (begin
     
    376342              (skiplist-search-level-set! sls k))))))))
    377343
    378 (define (skiplist-search-further! sls item)
     344(define (skiplist-search-continue! sls item)
    379345  ;; save cursors at every level below search level
    380   (do ((k (fx1- (skiplist-search-level sls)) (fx1- k)))
     346  (do ((k (fx- (skiplist-search-level sls) 1) (fx- k 1)))
    381347    ((negative? k))
    382348      ;; restart cursor at every lower cursor level with the result of the level above
    383     (set! (cursor-ref sls k) (cursor-ref sls (fx1+ k)))
     349    (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1)))
    384350    ;; advance cursor horizontally
    385351    (cursor-moveto! sls k item)))
     352
     353(define (choose-height width)
     354  (let loop ((choice (random width)) (k 1))
     355    (if (fx>= choice 1)
     356      k
     357      (loop (random width) (fx+ k 1)))))
    386358
    387359(define (skiplist-insert! sls item . items)
     
    390362    ;; restructure
    391363    (when (> height (skiplist-height sls))
     364      ;(set! (skiplist-finish sls) (snode gfinish height))
     365      ;(set! (skiplist-start sls)
     366      ;      (make-snode gstart
     367      ;                  (vector-resize (snode-next (skiplist-start sls))
     368      ;                                 height
     369      ;                                 (skiplist-finish sls))))
    392370      (set! (skiplist-cursor sls)
    393371            (vector-resize (skiplist-cursor sls)
     
    406384          (height (if (null? (skiplist-found sls))
    407385                    height
    408                     (skipnode-height
     386                    (snode-height
    409387                      (cursor-next sls (skiplist-search-level sls)))))
    410           (new (skipnode item height))
     388          (new (snode item height))
    411389          )
    412390          ;; prepare lower part of cursor for insertion
    413           (skiplist-search-further! sls item)
    414           (skiplist-count-set! sls (fx1+ (skiplist-count sls)))
     391          (skiplist-search-continue! sls item)
     392          (skiplist-count-set! sls (fx+ (skiplist-count sls) 1))
    415393          (skiplist-found-set! sls (cons item (skiplist-found sls)))
    416           (do ((k 0 (fx1+ k)))
     394          (do ((k 0 (fx+ k 1)))
    417395            ((fx= k height))
    418             (set! (skipnode-next-ref new k)
     396            (set! (snode-next-ref new k)
    419397                  (cursor-next sls k))
    420398            (set! (cursor-next sls k) new))))
     
    424402        (when (null? (skiplist-found sls))
    425403          ;; prepare lower part of cursor
    426           (skiplist-search-further! sls item)
    427           (let ((new (skipnode item height)))
    428             (skiplist-count-set! sls (fx1+ (skiplist-count sls)))
    429             (do ((k 0 (fx1+ k)))
     404          (skiplist-search-continue! sls item)
     405          (let ((new (snode item height)))
     406            (skiplist-count-set! sls (fx+ (skiplist-count sls) 1))
     407            (do ((k 0 (fx+ k 1)))
    430408              ((fx= k height))
    431               (set! (skipnode-next-ref new k)
     409              (set! (snode-next-ref new k)
    432410                    (cursor-next sls k))
    433411              (set! (cursor-next sls k) new)))))))
     
    446424        (do-while
    447425          (not (equal? item
    448                        (skipnode-item (cursor-next sls level))))
     426                       (snode-item (cursor-next sls level))))
    449427          (cursor-forth! sls level))
    450         (skiplist-search-further! sls item)
     428        (skiplist-search-continue! sls item)
    451429        (when (cursor-equal? sls level item)
    452430          (set! (cursor-next sls level)
    453                 (skipnode-next-ref (cursor-next sls level) level))
    454           (skiplist-count-set! sls (fx1- (skiplist-count sls)))
     431                (snode-next-ref (cursor-next sls level) level))
     432          (skiplist-count-set! sls (fx- (skiplist-count sls) 1))
    455433          (skiplist-found-set! sls (cdr (skiplist-found sls)))
    456           (do ((k 0 (fx1+ k)))
     434          (do ((k 0 (fx+ k 1)))
    457435            ((fx= k level))
    458436            (when (cursor-equal? sls k item)
    459437              (set! (cursor-next sls k)
    460                     (skipnode-next-ref (cursor-next sls k) k))))))))
     438                    (snode-next-ref (cursor-next sls k) k))))))))
    461439  ;; remove other items, if any
    462440  (do ((items items (cdr items)))
     
    465443
    466444(define (skiplist-for-each sls proc)
    467   (do ((node (skipnode-next-ref (skiplist-start sls) 0)
    468              (skipnode-next-ref node 0)))
    469     ((skipnode-finish? node)) ; way out
    470     (proc (skipnode-item node))))
     445  (do ((node (snode-next-ref (skiplist-start sls) 0)
     446             (snode-next-ref node 0)))
     447    ((snode-finish? node)) ; way out
     448    (proc (snode-item node))))
    471449
    472450(define (skiplist-clear! sls)
    473451  (skiplist-height-set! sls 1)
    474   (do ((k 0 (fx1+ k)))
    475     ((fx= k (skiplist-max-height sls)))
    476     (set! (skiplist-start-next sls k) (skiplist-finish sls)))
     452  (set! (skiplist-finish sls) (snode gfinish 1))
     453  (set! (skiplist-start sls) (snode gstart 1))
     454  (set! (skiplist-start-next sls 0) (skiplist-finish sls))
    477455  (set! (skiplist-cursor sls) (make-vector 1 (skiplist-start sls)))
    478456  (skiplist-count-set! sls 0))
    479457
    480 (define (skiplist-map sls proc . args)
     458(define (skiplist-map sls proc . target-structure)
    481459  (let (
    482460    (result
    483461      (cond
    484         ;; old width, max-height, item? and orders
    485         ((null? args)
    486          (apply skiplist
    487                 (skiplist-width sls)
    488                 (skiplist-max-height sls)
    489                 (skiplist-item? sls)
    490                 (skiplist-orders sls)))
    491         ;; old width and max-height,  new item? and orders
    492         ((and (fx> (length args) 1)
    493               ((list-of? procedure?) args))
    494          (apply skiplist
    495                 (skiplist-width sls)
    496                 (skiplist-max-height sls)
    497                 args))))
     462        ;; old width and orders
     463        ((null? target-structure)
     464         (apply skiplist (skiplist-width sls) (skiplist-item? sls) (skiplist-orders sls)))
     465        ;; old width, new item? and orders
     466        (((list-of? procedure?) target-structure)
     467         (apply skiplist (skiplist-width sls) target-structure))
     468        ;; new width, old item? and orders
     469        ((null? (cdr target-structure))
     470         (apply skiplist (car target-structure) (skiplist-item? sls) (skiplist-orders sls)))
     471        ;; new width, new item? and orders
     472        (else
     473          (apply skiplist target-structure))))
    498474    )
    499     (do ((node (skipnode-next-ref (skiplist-start sls) 0)
    500                (skipnode-next-ref node 0)))
    501       ((skipnode-finish? node)) ; way out
    502       (skiplist-insert! result (proc (skipnode-item node))))
     475    (do ((node (snode-next-ref (skiplist-start sls) 0)
     476               (snode-next-ref node 0)))
     477      ((snode-finish? node)) ; way out
     478      (skiplist-insert! result (proc (snode-item node))))
    503479    result))
    504480
    505481(define (skiplist-restructure sls width max-height)
     482  ;(skiplist-map sls identity width))
    506483  (let ((result (apply skiplist
    507484                       width
     
    509486                       (skiplist-item? sls)
    510487                       (skiplist-orders sls))))
    511     (do ((node (skipnode-next-ref (skiplist-start sls) 0) (skipnode-next-ref node 0)))
    512       ((skipnode-finish? node))
    513       (skiplist-insert! result (skipnode-item node)))
     488    (do ((node (snode-next-ref (skiplist-start sls) 0) (snode-next-ref node 0)))
     489      ((snode-finish? node))
     490      (skiplist-insert! result (snode-item node)))
    514491    result))
    515492
     
    521498                       (skiplist-item?  sls)
    522499                       order orders)))
    523     (do ((node (skipnode-next-ref (skiplist-start sls) 0) (skipnode-next-ref node 0)))
    524       ((skipnode-finish? node))
    525       (skiplist-insert! result (skipnode-item node)))
     500    (do ((node (snode-next-ref (skiplist-start sls) 0) (snode-next-ref node 0)))
     501      ((snode-finish? node))
     502      (skiplist-insert! result (snode-item node)))
    526503    result))
    527504
     
    532509                       (skiplist-item?  sls)
    533510                       (skiplist-orders sls))))
    534     (do ((node (skipnode-next-ref (skiplist-start sls) 0)
    535                (skipnode-next-ref node 0)))
    536       ((skipnode-finish? node)) ; way out
    537       (let ((item (skipnode-item node)))
     511    (do ((node (snode-next-ref (skiplist-start sls) 0)
     512               (snode-next-ref node 0)))
     513      ((snode-finish? node)) ; way out
     514      (let ((item (snode-item node)))
    538515        (if (ok? item) (skiplist-insert! result item))))
    539516    result))
     
    544521    (begin
    545522      (cursor-start! sls 0)
    546       ;(skipnode-item (cursor-ref sls 0)))
    547       (skiplist-search! sls (skipnode-item (cursor-ref sls 0)))
     523      ;(snode-item (cursor-ref sls 0)))
     524      (skiplist-search! sls (snode-item (cursor-ref sls 0)))
    548525      (skiplist-found sls))))
    549   ;(let ((item (skipnode-item (cursor-ref sls 0))))
     526  ;(let ((item (snode-item (cursor-ref sls 0))))
    550527  ;  (if (skiplist-dups? sls)
    551528  ;    (begin
     
    561538    '()
    562539    (begin
    563       (let ((top (fx1- (skiplist-height sls))))
     540      (let ((top (fx- (skiplist-height sls) 1)))
    564541        ;; save cursors at every level
    565         (do ((k top (fx1- k)))
     542        (do ((k top (fx- k 1)))
    566543          ((negative? k))
    567544          ;; at highest start where you are, it's always less gfinish
    568545          (if (fx< k top)
    569546            ;; start at every lower cursor level with the result of the level above
    570             (set! (cursor-ref sls k) (cursor-ref sls (fx1+ k))))
     547            (set! (cursor-ref sls k) (cursor-ref sls (fx+ k 1))))
    571548          ;; advance cursor horizontally
    572549          (cursor-moveto! sls k gfinish)))
    573       ;(skipnode-item (cursor-ref sls 0)))
    574       (skiplist-search! sls (skipnode-item (cursor-ref sls 0)))
     550      ;(snode-item (cursor-ref sls 0)))
     551      (skiplist-search! sls (snode-item (cursor-ref sls 0)))
    575552      (skiplist-found sls))))
    576553
     
    579556    (cursor-start! sls k)
    580557    (let loop ((node (cursor-ref sls k)) (result '()))
    581       (if (skipnode-finish? node)
     558      (if (snode-finish? node)
    582559        (reverse result)
    583         (loop (skipnode-next-ref node k) (cons (skipnode-item node) result))))))
     560        (loop (snode-next-ref node k) (cons (snode-item node) result))))))
    584561
    585562) ; module %skiplists
     
    592569        dbc
    593570        (only chicken cut
    594               fixnum? fx>= fx> fx< fx<= fx=)
     571              fixnum? fx+ fx- fx>= fx> fx< fx<= fx=)
    595572        ; get-output-string open-output-string)
    596573        (only data-structures list-of? constantly)
     
    614591          "like order, last one might be dups")
    615592     (%skiplist? result))
    616     ((_ max-height item? order . orders)
    617      (and (fixnum? max-height) (fx> max-height 1)
     593    ((_ width item? order . orders)
     594     (and (fixnum? width) (fx> width 1)
    618595          (procedure? item?) "(item? item)"
    619596          (procedure? order) "(fixnum? (order item? item?))"
     
    705682  %skiplist-max)
    706683
     684(define-with-contract skiplist-max-height ;;new
     685  (contract (result)
     686    ((_ sls)
     687     (%skiplist? sls)
     688     (and (fixnum? result) (fx> result 0))))
     689  %skiplist-max-height)
    707690
    708691;; maximum heigth of nodes in skiplist
     
    721704     (and (fixnum? result) (fx> result 1))))
    722705  %skiplist-width)
    723 
    724 ;; maximal height
    725 (define-with-contract skiplist-max-height
    726   (contract (result)
    727     ((_ sls)
    728      (%skiplist? sls)
    729      (and (fixnum? result) (fx> result 1))))
    730   %skiplist-max-height)
    731706
    732707;; number of items stored in skiplist
     
    790765     (and (%skiplist? sls) (procedure? fn) "((skiplist-item? sls) (fn x))")
    791766     (%skiplist? result))
    792     ((_ sls fn order . orders) ;;;
     767    ((_ sls fn order . orders)
    793768     (and (%skiplist? sls) (procedure? fn)
    794           ((list-of? procedure?) (cons order orders)))
     769          (((list-of? procedure?) (cons order orders))))
    795770     (%skiplist? result))
    796771    ((_ sls fn width)
     
    798773          (procedure? fn) "((skiplist-item? sls) (fn x))")
    799774     (%skiplist? result))
    800     ((_ sls fn width order . orders) ;;;
     775    ((_ sls fn width order . orders)
    801776     (and (%skiplist? sls) (procedure? fn)
    802777          (fixnum? width) (fx> width 1)
    803           ((list-of? procedure?) (cons order orders)))
    804      (%skiplist? result))
    805     )
     778          (((list-of? procedure?) (cons order orders))))
     779     (%skiplist? result)))
    806780  %skiplist-map)
    807781
  • release/4/skiplists/trunk/skiplists.setup

    r30430 r34042  
    88 'skiplists
    99 '("skiplists.so" "%skiplists.import.so" "skiplists.import.so")
    10  '((version "1.1.4")))
     10 '((version "1.1.5")))
Note: See TracChangeset for help on using the changeset viewer.