Changeset 27161 in project

Timestamp:

08/02/12 17:50:51 (8 years ago)

Author:

juergen

Message:

version 0.6 with restructured code (additional module

Location:

release/4/skiplists

Files:

• tags/0.6 (copied) (copied from release/4/skiplists/trunk)
• tags/0.6/skiplists.scm (copied) (copied from release/4/skiplists/trunk/skiplists.scm) (22 diffs)
• tags/0.6/skiplists.setup (copied) (copied from release/4/skiplists/trunk/skiplists.setup) (1 diff)
• trunk/skiplists.scm (modified) (22 diffs)
• trunk/skiplists.setup (modified) (1 diff)

release/4/skiplists/tags/0.6/skiplists.scm

@@ -33 +33 @@
 ;         ju (at) jugilo (dot) de
 ;
-; Last update: May 21, 2012
+; Last update: Aug 2, 2012
 ;
 ;Rationale
@@ -74 +74 @@
 ;below n.
 ;
-(require 'records 'contracts)
-
-(module skiplists
-  (skiplists skiplist? make-skiplist make-skiplist-with-gap skip-compare
-             make-skiplist-from-list make-skiplist-with-gap-from-list
-             skip-search!  skip-insert! skip-remove! skip-list skip-gap skip-count
-             skip-remove-all! skip-found? skip-dups? skip-links skip-max-links dups
-             skip-restructure skip-for-each skip-orders skip-reorder
-             skip-filter)
+(require-library records contracts)
+
+(module %skiplists
+  (skiplist? make-skiplist make-skiplist-with-gap skip-compare
+   make-skiplist-from-list make-skiplist-with-gap-from-list
+   skip-search!  skip-insert! skip-remove! skip-list skip-gap skip-count
+   skip-remove-all! skip-found? skip-dups? skip-links skip-max-links dups
+   skip-restructure skip-for-each skip-orders skip-reorder
+   skip-filter)
 
 (import scheme records
-  (only contracts doclist doclist->dispatcher contract define-with-contract)
   (only chicken
     assert when unless keyword? optional
-    getter-with-setter print get-output-string open-output-string)
+    getter-with-setter print); get-output-string open-output-string)
   (only data-structures list-of?)
   (only extras random))
-
-;; initialize documentation
-(doclist '())
 
 ;;;; skipnode ADT (hidden)
@@ -149 +145 @@
     '(orders gap links count cursor start)))
 
+(define skiplist?  (record-predicate skip-type))
+
+(define skip-maker
+  (record-constructor skip-type))
+
+(define skip-orders (record-accessor skip-type 'orders))
+
+(define skip-gap (record-accessor skip-type 'gap))
+
+(define skip-count
+  (getter-with-setter (record-accessor skip-type 'count)
+                      (record-modifier skip-type 'count)))
+
+(define skip-links
+  (getter-with-setter (record-accessor skip-type 'links)
+                      (record-modifier skip-type 'links)))
+
+(define (skip-cursor skp)
+  (make-skipnode cursor: ((record-accessor skip-type 'cursor) skp)))
+
+(define (skip-start skp)
+  (make-skipnode start: ((record-accessor skip-type 'start) skp)))
+
+(define (make-skiplist max-links . orders)
+  (apply make-skiplist-with-gap max-links 2 orders))
+
+(define (make-skiplist-with-gap max-links gap . orders)
+  (skip-maker orders gap 1 0
+              (make-vector max-links '())
+              (make-vector max-links '())))
+
+(define (make-skiplist-from-list lst max-links . orders)
+  (apply make-skiplist-with-gap-from-list lst max-links 2 orders))
+
+(define (make-skiplist-with-gap-from-list lst max-links gap . orders)
+  (let ((skp (apply make-skiplist-with-gap max-links gap orders)))
+    (let loop ((lst lst))
+      (unless (null? lst)
+        (skip-insert! skp (car lst))
+        (loop (cdr lst))))
+    skp))
+
+(define (skip-restructure skp max-links gap)
+  (let (
+    (result (apply make-skiplist-with-gap max-links gap (skip-orders skp)))
+    )
+    (let loop ((node (skipnode-next (skip-start skp) 0)))
+      (unless (null? node)
+        (skip-insert! result (skipnode-item node))
+        (loop (skipnode-next node 0))))
+    result))
+
+(define (skip-reorder skp . orders)
+  (let ((result (apply make-skiplist-with-gap
+                    (skip-max-links skp)
+                    (skip-gap skp)
+                    orders)))
+    (let loop ((node (skipnode-next (skip-start skp) 0)))
+      (unless (null? node)
+        (skip-insert! result (skipnode-item node))
+        (loop (skipnode-next node 0))))
+    result))
+
+(define (skip-for-each skp proc)
+  (let loop ((node (skipnode-next (skip-start skp) 0)))
+    (unless (null? node)
+      (proc (skipnode-item node))
+      (loop (skipnode-next node 0)))))
+
+(define (skip-filter skp ok?)
+  (let ((result (apply make-skiplist-with-gap
+                       (skip-max-links skp)
+                       (skip-gap skp)
+                       (skip-orders skp))))
+    (let loop ((node (skipnode-next (skip-start skp) 0)))
+      (unless (null? node)
+        (let ((item (skipnode-item node)))
+          (if (ok? item) (skip-insert! result item)))
+        (loop (skipnode-next node 0))))
+    result))
+
+(define (skip-list skp . ks)
+  (let ((k ;(if (null? ks) 0 (car ks))))
+           (optional ks 0)))
+    (let loop ((node (skipnode-next (skip-start skp) k)) (lst '()))
+      (if (null? node)
+        (reverse lst)
+        (loop (skipnode-next node k) (cons (skipnode-item node) lst))))))
+
+(define (skip-max-links skp)
+  (skipnode-links (skip-start skp)))
+
+(define (skip-dups? skp)
+  ;; more than one initial comparison operator
+  (not (null? (cdr (skip-orders skp)))))
+
+(define (skip-compare skp)
+  (let loop ((orders (skip-orders skp)))
+    (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))))))))
+
+(define (skip-search! skp item . flags)
+  (let ((lazy? (optional flags #t)) (cursor (skip-cursor skp)))
+    ; the lazy? argument is set to #f in skip-insert! to cope
+    ; with lists which are alreade sorted
+    (let down (
+      (k (- (skip-links skp) 1))
+      ;(node (skip-start skp))
+      (node (if (and lazy? (skip-lazy? skp item))
+              cursor
+              (skip-start skp)))
+      )
+      (unless (negative? k)
+        (let forward ((node node))
+          (let ((next (skipnode-next node k)))
+            (if (skip-in? skp item next)
+              (forward next)
+              (begin
+                (set! (skipnode-next cursor k) node)
+                (down (- k 1) node)))))))))
+
+(define (skip-found? skp item)
+  (let ((node (skipnode-next (skip-cursor skp) 0)))
+    (and (not (null? node))
+         (not (null? (skipnode-next node 0)))
+         (zero? ((skip-compare skp) item (skipnode-item (skipnode-next node 0)))))))
+
+(define (skip-lazy? skp item)
+  (let ((node (skipnode-next (skip-cursor skp) 0)))
+    (and (not (null? node))
+         (not (keyword? (skipnode-item node)))
+         (positive? ((skip-compare skp) item (skipnode-item node))))))
+
+(define (skip-in? skp item node)
+  (and (not (null? node))
+       (not (keyword? (skipnode-item node)))
+       (> ((skip-compare skp) item (skipnode-item node)) 0)))
+
+(define (skip-insert! skp item)
+  (skip-search! skp item #f)
+  (unless (and (not (skip-dups? skp)) (skip-found? skp item))
+    (let ((newlinks (skip-rand skp)) (links (skip-links skp)))
+      (if (> newlinks links)
+        (set! (skip-links skp) newlinks))
+      (skipnode-insert! (skip-cursor skp)
+                        (make-skipnode item (make-vector newlinks '())))
+      (set! (skip-count skp) (+ (skip-count skp) 1)))))
+
+(define (skip-remove! skp item)
+  (skip-search! skp item)
+  (when (skip-found? skp item)
+    (skipnode-remove! (skip-cursor skp) (skip-links skp))
+    (set! (skip-count skp) (- (skip-count skp) 1))))
+
+(define (skip-remove-all! skp item)
+  (skip-search! skp item)
+  (let loop ((found (skip-found? skp item)))
+    (when found
+      (skipnode-remove! (skip-cursor skp) (skip-links skp))
+      (set! (skip-count skp) (- (skip-count skp) 1))
+      (loop (skip-found? skp item)))))
+
+;;; to skip gap nodes at a time in the 2nd level (link index 1), one
+;;; out of every gap nodes must have at least 2 links. Iterating we
+;;; want one out of every gap^i nodes to have at least i+1 links.
+(define (skip-rand skp)
+  (let ((max-links (skip-max-links skp)))
+    (if (= max-links 1)
+      1 ; normal list, no randomization
+      (let* (
+        (gap (skip-gap skp))
+        (M (expt gap max-links))
+        (choice  (+ (random M) 1)) ; 0<=(random M)<M
+        )                          ; 1<=choice<=M
+        (assert (exact? M) "too many links in skip-rand" max-links)
+        (let loop ((links 1) (barrier (quotient M gap)))
+          (if (>= choice barrier)
+            links
+            (loop (+ links 1) (quotient barrier gap))))))))
+
+(define (dups x y)
+  0)
+
+) ; module %skiplists
+
+(module skiplists
+  (skiplists skiplist? make-skiplist make-skiplist-with-gap skip-compare
+             make-skiplist-from-list make-skiplist-with-gap-from-list
+             skip-search!  skip-insert! skip-remove! skip-list skip-gap skip-count
+             skip-remove-all! skip-found? skip-dups? skip-links skip-max-links dups
+             skip-restructure skip-for-each skip-orders skip-reorder
+             skip-filter)
+
+(import scheme
+  (prefix %skiplists %)
+  (only contracts doclist doclist->dispatcher contract define-with-contract)
+  (only chicken unless get-output-string open-output-string)
+  (only data-structures list-of?))
+
+;; initialize documentation
+(doclist '())
+
+;;;; skiplist ADT
+
 (define-with-contract (skiplist? xpr)
   "type predicate"
   (%skiplist? xpr))
 
-(define %skiplist?  (record-predicate skip-type))
-
-(define skip-maker
-  (record-constructor skip-type))
-
 (define-with-contract (skip-orders skp)
   "list of numerical comparison operators"
@@ -164 +365 @@
   (%skip-orders skp))
 
-(define %skip-orders (record-accessor skip-type 'orders))
-
 (define-with-contract (skip-gap skp)
   "gap of skiplist"
@@ -172 +371 @@
   (%skip-gap skp))
 
-(define %skip-gap (record-accessor skip-type 'gap))
-  
-
 (define-with-contract (skip-count skp)
   "number of nodes stored in skiplist"
@@ -181 +377 @@
   (%skip-count skp))
 
-(define %skip-count
-  (getter-with-setter (record-accessor skip-type 'count)
-                      (record-modifier skip-type 'count)))
-
 (define-with-contract (skip-links skp)
   "maximal number of occupied links"
@@ -190 +382 @@
   (range (integer? result) (>= (%skip-max-links skp) result 1))
   (%skip-links skp))
-
-(define %skip-links
-  (getter-with-setter (record-accessor skip-type 'links)
-                      (record-modifier skip-type 'links)))
-
-(define (skip-cursor skp)
-  (make-skipnode cursor: ((record-accessor skip-type 'cursor) skp)))
-
-(define (skip-start skp)
-  (make-skipnode start: ((record-accessor skip-type 'start) skp)))
 
 (define-with-contract (make-skiplist max-links . orders)
@@ -220 +402 @@
   (apply %make-skiplist-with-gap max-links gap orders))
   
-(define (%make-skiplist-with-gap max-links gap . orders)
-  (skip-maker orders gap 1 0
-              (make-vector max-links '())
-              (make-vector max-links '())))
-
 (define-with-contract (make-skiplist-from-list lst max-links . orders)
   "construct a skiplist from an ordinary list"
@@ -249 +426 @@
   (apply %make-skiplist-with-gap-from-list lst max-links gap orders))
 
-(define (%make-skiplist-with-gap-from-list lst max-links gap . orders)
-  (let ((skp (apply %make-skiplist-with-gap max-links gap orders)))
-    (let loop ((lst lst))
-      (unless (null? lst)
-        (%skip-insert! skp (car lst))
-        (loop (cdr lst))))
-    skp))
-
 (define-with-contract (skip-restructure skp max-links gap)
   "restructure skiplist by changing max-links and gap"
@@ -265 +434 @@
          (= (%skip-gap result) gap))
   (%skip-restructure skp max-links gap))
-
-(define (%skip-restructure skp max-links gap)
-  (let (
-    (result (apply %make-skiplist-with-gap max-links gap (%skip-orders skp)))
-    )
-    (let loop ((node (skipnode-next (skip-start skp) 0)))
-      (unless (null? node)
-        (%skip-insert! result (skipnode-item node))
-        (loop (skipnode-next node 0))))
-    result))
 
 (define-with-contract (skip-reorder skp . orders)
@@ -286 +445 @@
   (apply %skip-reorder skp orders))
 
-(define (%skip-reorder skp . orders)
-  (let ((result (apply %make-skiplist-with-gap
-                    (%skip-max-links skp)
-                    (%skip-gap skp)
-                    orders)))
-    (let loop ((node (skipnode-next (skip-start skp) 0)))
-      (unless (null? node)
-        (%skip-insert! result (skipnode-item node))
-        (loop (skipnode-next node 0))))
-    result))
-
 (define (set-in? lst1 lst2)
   (let loop ((lst lst1))
@@ -309 +457 @@
           (procedure? proc))
   (%skip-for-each skp proc))
-
-(define (%skip-for-each skp proc)
-  (let loop ((node (skipnode-next (skip-start skp) 0)))
-    (unless (null? node)
-      (proc (skipnode-item node))
-      (loop (skipnode-next node 0)))))
 
 (define-with-contract (skip-filter skp ok?)
@@ -323 +465 @@
   (range (%skiplist? result))
   (%skip-filter skp ok?))
-
-(define (%skip-filter skp ok?)
-  (let ((result (apply %make-skiplist-with-gap
-                       (%skip-max-links skp)
-                       (%skip-gap skp)
-                       (%skip-orders skp))))
-    (let loop ((node (skipnode-next (skip-start skp) 0)))
-      (unless (null? node)
-        (let ((item (skipnode-item node)))
-          (if (ok? item) (%skip-insert! result item)))
-        (loop (skipnode-next node 0))))
-    result))
 
 (define-with-contract (skip-list skp . ks)
@@ -346 +476 @@
   (apply %skip-list skp ks))
 
-(define (%skip-list skp . ks)
-  (let ((k ;(if (null? ks) 0 (car ks))))
-           (optional ks 0)))
-    (let loop ((node (skipnode-next (skip-start skp) k)) (lst '()))
-      (if (null? node)
-        (reverse lst)
-        (loop (skipnode-next node k) (cons (skipnode-item node) lst))))))
-
 (define-with-contract (skip-max-links skp)
   "maximal number of links"
@@ -360 +482 @@
   (%skip-max-links skp))
 
-(define (%skip-max-links skp)
-  (skipnode-links (skip-start skp)))
-
 (define-with-contract (skip-dups? skp)
   "check if duplicates are allowed"
@@ -368 +487 @@
   (%skip-dups? skp))
 
-(define (%skip-dups? skp)
-  ;; more than one initial comparison operator
-  (not (null? (cdr (%skip-orders skp)))))
-
 (define-with-contract (skip-compare skp)
   "combined numerical comparison procedure"
@@ -377 +492 @@
   (range (procedure? result))
   (%skip-compare skp))
-
-(define (%skip-compare skp)
-  (let loop ((orders (%skip-orders skp)))
-    (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))))))))
 
 (define-with-contract (skip-search! skp item)
@@ -396 +500 @@
   (%skip-search! skp item))
   
-(define (%skip-search! skp item . flags)
-  (let ((lazy? (optional flags #t)) (cursor (skip-cursor skp)))
-    ; the lazy? argument is set to #f in skip-insert! to cope
-    ; with lists which are alreade sorted
-    (let down (
-      (k (- (%skip-links skp) 1))
-      ;(node (skip-start skp))
-      (node (if (and lazy? (skip-lazy? skp item))
-              cursor
-              (skip-start skp)))
-      )
-      (unless (negative? k)
-        (let forward ((node node))
-;(print k " " (skipnode-item node))
-          (let ((next (skipnode-next node k)))
-            (if (skip-in? skp item next)
-              (forward next)
-              (begin
-                (set! (skipnode-next cursor k) node)
-                (down (- k 1) node)))))))))
-
 (define-with-contract (skip-found? skp item)
   "check, if last skip-search! was successfull"
@@ -422 +505 @@
   (range (boolean? result))
   (%skip-found? skp item))
-
-(define (%skip-found? skp item)
-  (let ((node (skipnode-next (skip-cursor skp) 0)))
-    (and (not (null? node))
-         (not (null? (skipnode-next node 0)))
-         (zero? ((%skip-compare skp) item (skipnode-item (skipnode-next node 0)))))))
-
-(define (skip-lazy? skp item)
-  (let ((node (skipnode-next (skip-cursor skp) 0)))
-    (and (not (null? node))
-         (not (keyword? (skipnode-item node)))
-         (positive? ((%skip-compare skp) item (skipnode-item node))))))
-
-(define (skip-in? skp item node)
-  (and (not (null? node))
-       (not (keyword? (skipnode-item node)))
-       (> ((%skip-compare skp) item (skipnode-item node)) 0)))
 
 (define-with-contract (skip-insert! skp . items)
@@ -450 +516 @@
       (loop (cdr items)))))
 
-(define (%skip-insert! skp item)
-  (%skip-search! skp item #f)
-  (unless (and (not (%skip-dups? skp)) (skip-found? skp item))
-    (let ((newlinks (skip-rand skp)) (links (%skip-links skp)))
-      (if (> newlinks links)
-        (set! (%skip-links skp) newlinks))
-      (skipnode-insert! (skip-cursor skp)
-                        (make-skipnode item (make-vector newlinks '())))
-      (set! (%skip-count skp) (+ (%skip-count skp) 1)))))
-
 (define-with-contract (skip-remove! skp . items)
   "remove nodes (one per found item) with items from skiplist"
@@ -469 +525 @@
     (loop (cdr items)))))
   
-(define (%skip-remove! skp item)
-  (skip-search! skp item)
-  (when (skip-found? skp item)
-    (skipnode-remove! (skip-cursor skp) (%skip-links skp))
-    (set! (%skip-count skp) (- (%skip-count skp) 1))))
-
 (define-with-contract (skip-remove-all! skp . items)
   "remove nodes (all per found item) with items from skiplist"
@@ -484 +534 @@
     (loop (cdr items)))))
   
-(define (%skip-remove-all! skp item)
-  (skip-search! skp item)
-  (let loop ((found (skip-found? skp item)))
-    (when found
-      (skipnode-remove! (skip-cursor skp) (%skip-links skp))
-      (set! (%skip-count skp) (- (%skip-count skp) 1))
-      (loop (skip-found? skp item)))))
-
-;;; to skip gap nodes at a time in the 2nd level (link index 1), one
-;;; out of every gap nodes must have at least 2 links. Iterating we
-;;; want one out of every gap^i nodes to have at least i+1 links.
-(define (skip-rand skp)
-  (let ((max-links (%skip-max-links skp)))
-    (if (= max-links 1)
-      1 ; normal list, no randomization
-      (let* (
-        (gap (%skip-gap skp))
-        (M (expt gap max-links))
-        (choice  (+ (random M) 1)) ; 0<=(random M)<M
-        )                          ; 1<=choice<=M
-        (assert (exact? M) "too many links in skip-rand" max-links)
-        (let loop ((links 1) (barrier (quotient M gap)))
-          (if (>= choice barrier)
-            links
-            (loop (+ links 1) (quotient barrier gap))))))))
-
 (define-with-contract (dups x y)
   "trivial numerical comparison operator to allow for duplicates"

release/4/skiplists/tags/0.6/skiplists.setup

@@ -3 +3 @@
 (compile -O2 -s -d1 skiplists.scm -J)
 (compile -O3 -d0 -s skiplists.import.scm)
+(compile -O3 -d0 -s %skiplists.import.scm)
 
 (install-extension
  'skiplists
- '("skiplists.so" "skiplists.import.so")
- '((version "0.5")))
+ '("skiplists.so" "%skiplists.import.so" "skiplists.import.so")
+ '((version "0.6")))
 
 

release/4/skiplists/trunk/skiplists.scm

@@ -33 +33 @@
 ;         ju (at) jugilo (dot) de
 ;
-; Last update: May 21, 2012
+; Last update: Aug 2, 2012
 ;
 ;Rationale
@@ -74 +74 @@
 ;below n.
 ;
-(require 'records 'contracts)
-
-(module skiplists
-  (skiplists skiplist? make-skiplist make-skiplist-with-gap skip-compare
-             make-skiplist-from-list make-skiplist-with-gap-from-list
-             skip-search!  skip-insert! skip-remove! skip-list skip-gap skip-count
-             skip-remove-all! skip-found? skip-dups? skip-links skip-max-links dups
-             skip-restructure skip-for-each skip-orders skip-reorder
-             skip-filter)
+(require-library records contracts)
+
+(module %skiplists
+  (skiplist? make-skiplist make-skiplist-with-gap skip-compare
+   make-skiplist-from-list make-skiplist-with-gap-from-list
+   skip-search!  skip-insert! skip-remove! skip-list skip-gap skip-count
+   skip-remove-all! skip-found? skip-dups? skip-links skip-max-links dups
+   skip-restructure skip-for-each skip-orders skip-reorder
+   skip-filter)
 
 (import scheme records
-  (only contracts doclist doclist->dispatcher contract define-with-contract)
   (only chicken
     assert when unless keyword? optional
-    getter-with-setter print get-output-string open-output-string)
+    getter-with-setter print); get-output-string open-output-string)
   (only data-structures list-of?)
   (only extras random))
-
-;; initialize documentation
-(doclist '())
 
 ;;;; skipnode ADT (hidden)
@@ -149 +145 @@
     '(orders gap links count cursor start)))
 
+(define skiplist?  (record-predicate skip-type))
+
+(define skip-maker
+  (record-constructor skip-type))
+
+(define skip-orders (record-accessor skip-type 'orders))
+
+(define skip-gap (record-accessor skip-type 'gap))
+
+(define skip-count
+  (getter-with-setter (record-accessor skip-type 'count)
+                      (record-modifier skip-type 'count)))
+
+(define skip-links
+  (getter-with-setter (record-accessor skip-type 'links)
+                      (record-modifier skip-type 'links)))
+
+(define (skip-cursor skp)
+  (make-skipnode cursor: ((record-accessor skip-type 'cursor) skp)))
+
+(define (skip-start skp)
+  (make-skipnode start: ((record-accessor skip-type 'start) skp)))
+
+(define (make-skiplist max-links . orders)
+  (apply make-skiplist-with-gap max-links 2 orders))
+
+(define (make-skiplist-with-gap max-links gap . orders)
+  (skip-maker orders gap 1 0
+              (make-vector max-links '())
+              (make-vector max-links '())))
+
+(define (make-skiplist-from-list lst max-links . orders)
+  (apply make-skiplist-with-gap-from-list lst max-links 2 orders))
+
+(define (make-skiplist-with-gap-from-list lst max-links gap . orders)
+  (let ((skp (apply make-skiplist-with-gap max-links gap orders)))
+    (let loop ((lst lst))
+      (unless (null? lst)
+        (skip-insert! skp (car lst))
+        (loop (cdr lst))))
+    skp))
+
+(define (skip-restructure skp max-links gap)
+  (let (
+    (result (apply make-skiplist-with-gap max-links gap (skip-orders skp)))
+    )
+    (let loop ((node (skipnode-next (skip-start skp) 0)))
+      (unless (null? node)
+        (skip-insert! result (skipnode-item node))
+        (loop (skipnode-next node 0))))
+    result))
+
+(define (skip-reorder skp . orders)
+  (let ((result (apply make-skiplist-with-gap
+                    (skip-max-links skp)
+                    (skip-gap skp)
+                    orders)))
+    (let loop ((node (skipnode-next (skip-start skp) 0)))
+      (unless (null? node)
+        (skip-insert! result (skipnode-item node))
+        (loop (skipnode-next node 0))))
+    result))
+
+(define (skip-for-each skp proc)
+  (let loop ((node (skipnode-next (skip-start skp) 0)))
+    (unless (null? node)
+      (proc (skipnode-item node))
+      (loop (skipnode-next node 0)))))
+
+(define (skip-filter skp ok?)
+  (let ((result (apply make-skiplist-with-gap
+                       (skip-max-links skp)
+                       (skip-gap skp)
+                       (skip-orders skp))))
+    (let loop ((node (skipnode-next (skip-start skp) 0)))
+      (unless (null? node)
+        (let ((item (skipnode-item node)))
+          (if (ok? item) (skip-insert! result item)))
+        (loop (skipnode-next node 0))))
+    result))
+
+(define (skip-list skp . ks)
+  (let ((k ;(if (null? ks) 0 (car ks))))
+           (optional ks 0)))
+    (let loop ((node (skipnode-next (skip-start skp) k)) (lst '()))
+      (if (null? node)
+        (reverse lst)
+        (loop (skipnode-next node k) (cons (skipnode-item node) lst))))))
+
+(define (skip-max-links skp)
+  (skipnode-links (skip-start skp)))
+
+(define (skip-dups? skp)
+  ;; more than one initial comparison operator
+  (not (null? (cdr (skip-orders skp)))))
+
+(define (skip-compare skp)
+  (let loop ((orders (skip-orders skp)))
+    (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))))))))
+
+(define (skip-search! skp item . flags)
+  (let ((lazy? (optional flags #t)) (cursor (skip-cursor skp)))
+    ; the lazy? argument is set to #f in skip-insert! to cope
+    ; with lists which are alreade sorted
+    (let down (
+      (k (- (skip-links skp) 1))
+      ;(node (skip-start skp))
+      (node (if (and lazy? (skip-lazy? skp item))
+              cursor
+              (skip-start skp)))
+      )
+      (unless (negative? k)
+        (let forward ((node node))
+          (let ((next (skipnode-next node k)))
+            (if (skip-in? skp item next)
+              (forward next)
+              (begin
+                (set! (skipnode-next cursor k) node)
+                (down (- k 1) node)))))))))
+
+(define (skip-found? skp item)
+  (let ((node (skipnode-next (skip-cursor skp) 0)))
+    (and (not (null? node))
+         (not (null? (skipnode-next node 0)))
+         (zero? ((skip-compare skp) item (skipnode-item (skipnode-next node 0)))))))
+
+(define (skip-lazy? skp item)
+  (let ((node (skipnode-next (skip-cursor skp) 0)))
+    (and (not (null? node))
+         (not (keyword? (skipnode-item node)))
+         (positive? ((skip-compare skp) item (skipnode-item node))))))
+
+(define (skip-in? skp item node)
+  (and (not (null? node))
+       (not (keyword? (skipnode-item node)))
+       (> ((skip-compare skp) item (skipnode-item node)) 0)))
+
+(define (skip-insert! skp item)
+  (skip-search! skp item #f)
+  (unless (and (not (skip-dups? skp)) (skip-found? skp item))
+    (let ((newlinks (skip-rand skp)) (links (skip-links skp)))
+      (if (> newlinks links)
+        (set! (skip-links skp) newlinks))
+      (skipnode-insert! (skip-cursor skp)
+                        (make-skipnode item (make-vector newlinks '())))
+      (set! (skip-count skp) (+ (skip-count skp) 1)))))
+
+(define (skip-remove! skp item)
+  (skip-search! skp item)
+  (when (skip-found? skp item)
+    (skipnode-remove! (skip-cursor skp) (skip-links skp))
+    (set! (skip-count skp) (- (skip-count skp) 1))))
+
+(define (skip-remove-all! skp item)
+  (skip-search! skp item)
+  (let loop ((found (skip-found? skp item)))
+    (when found
+      (skipnode-remove! (skip-cursor skp) (skip-links skp))
+      (set! (skip-count skp) (- (skip-count skp) 1))
+      (loop (skip-found? skp item)))))
+
+;;; to skip gap nodes at a time in the 2nd level (link index 1), one
+;;; out of every gap nodes must have at least 2 links. Iterating we
+;;; want one out of every gap^i nodes to have at least i+1 links.
+(define (skip-rand skp)
+  (let ((max-links (skip-max-links skp)))
+    (if (= max-links 1)
+      1 ; normal list, no randomization
+      (let* (
+        (gap (skip-gap skp))
+        (M (expt gap max-links))
+        (choice  (+ (random M) 1)) ; 0<=(random M)<M
+        )                          ; 1<=choice<=M
+        (assert (exact? M) "too many links in skip-rand" max-links)
+        (let loop ((links 1) (barrier (quotient M gap)))
+          (if (>= choice barrier)
+            links
+            (loop (+ links 1) (quotient barrier gap))))))))
+
+(define (dups x y)
+  0)
+
+) ; module %skiplists
+
+(module skiplists
+  (skiplists skiplist? make-skiplist make-skiplist-with-gap skip-compare
+             make-skiplist-from-list make-skiplist-with-gap-from-list
+             skip-search!  skip-insert! skip-remove! skip-list skip-gap skip-count
+             skip-remove-all! skip-found? skip-dups? skip-links skip-max-links dups
+             skip-restructure skip-for-each skip-orders skip-reorder
+             skip-filter)
+
+(import scheme
+  (prefix %skiplists %)
+  (only contracts doclist doclist->dispatcher contract define-with-contract)
+  (only chicken unless get-output-string open-output-string)
+  (only data-structures list-of?))
+
+;; initialize documentation
+(doclist '())
+
+;;;; skiplist ADT
+
 (define-with-contract (skiplist? xpr)
   "type predicate"
   (%skiplist? xpr))
 
-(define %skiplist?  (record-predicate skip-type))
-
-(define skip-maker
-  (record-constructor skip-type))
-
 (define-with-contract (skip-orders skp)
   "list of numerical comparison operators"
@@ -164 +365 @@
   (%skip-orders skp))
 
-(define %skip-orders (record-accessor skip-type 'orders))
-
 (define-with-contract (skip-gap skp)
   "gap of skiplist"
@@ -172 +371 @@
   (%skip-gap skp))
 
-(define %skip-gap (record-accessor skip-type 'gap))
-  
-
 (define-with-contract (skip-count skp)
   "number of nodes stored in skiplist"
@@ -181 +377 @@
   (%skip-count skp))
 
-(define %skip-count
-  (getter-with-setter (record-accessor skip-type 'count)
-                      (record-modifier skip-type 'count)))
-
 (define-with-contract (skip-links skp)
   "maximal number of occupied links"
@@ -190 +382 @@
   (range (integer? result) (>= (%skip-max-links skp) result 1))
   (%skip-links skp))
-
-(define %skip-links
-  (getter-with-setter (record-accessor skip-type 'links)
-                      (record-modifier skip-type 'links)))
-
-(define (skip-cursor skp)
-  (make-skipnode cursor: ((record-accessor skip-type 'cursor) skp)))
-
-(define (skip-start skp)
-  (make-skipnode start: ((record-accessor skip-type 'start) skp)))
 
 (define-with-contract (make-skiplist max-links . orders)
@@ -220 +402 @@
   (apply %make-skiplist-with-gap max-links gap orders))
   
-(define (%make-skiplist-with-gap max-links gap . orders)
-  (skip-maker orders gap 1 0
-              (make-vector max-links '())
-              (make-vector max-links '())))
-
 (define-with-contract (make-skiplist-from-list lst max-links . orders)
   "construct a skiplist from an ordinary list"
@@ -249 +426 @@
   (apply %make-skiplist-with-gap-from-list lst max-links gap orders))
 
-(define (%make-skiplist-with-gap-from-list lst max-links gap . orders)
-  (let ((skp (apply %make-skiplist-with-gap max-links gap orders)))
-    (let loop ((lst lst))
-      (unless (null? lst)
-        (%skip-insert! skp (car lst))
-        (loop (cdr lst))))
-    skp))
-
 (define-with-contract (skip-restructure skp max-links gap)
   "restructure skiplist by changing max-links and gap"
@@ -265 +434 @@
          (= (%skip-gap result) gap))
   (%skip-restructure skp max-links gap))
-
-(define (%skip-restructure skp max-links gap)
-  (let (
-    (result (apply %make-skiplist-with-gap max-links gap (%skip-orders skp)))
-    )
-    (let loop ((node (skipnode-next (skip-start skp) 0)))
-      (unless (null? node)
-        (%skip-insert! result (skipnode-item node))
-        (loop (skipnode-next node 0))))
-    result))
 
 (define-with-contract (skip-reorder skp . orders)
@@ -286 +445 @@
   (apply %skip-reorder skp orders))
 
-(define (%skip-reorder skp . orders)
-  (let ((result (apply %make-skiplist-with-gap
-                    (%skip-max-links skp)
-                    (%skip-gap skp)
-                    orders)))
-    (let loop ((node (skipnode-next (skip-start skp) 0)))
-      (unless (null? node)
-        (%skip-insert! result (skipnode-item node))
-        (loop (skipnode-next node 0))))
-    result))
-
 (define (set-in? lst1 lst2)
   (let loop ((lst lst1))
@@ -309 +457 @@
           (procedure? proc))
   (%skip-for-each skp proc))
-
-(define (%skip-for-each skp proc)
-  (let loop ((node (skipnode-next (skip-start skp) 0)))
-    (unless (null? node)
-      (proc (skipnode-item node))
-      (loop (skipnode-next node 0)))))
 
 (define-with-contract (skip-filter skp ok?)
@@ -323 +465 @@
   (range (%skiplist? result))
   (%skip-filter skp ok?))
-
-(define (%skip-filter skp ok?)
-  (let ((result (apply %make-skiplist-with-gap
-                       (%skip-max-links skp)
-                       (%skip-gap skp)
-                       (%skip-orders skp))))
-    (let loop ((node (skipnode-next (skip-start skp) 0)))
-      (unless (null? node)
-        (let ((item (skipnode-item node)))
-          (if (ok? item) (%skip-insert! result item)))
-        (loop (skipnode-next node 0))))
-    result))
 
 (define-with-contract (skip-list skp . ks)
@@ -346 +476 @@
   (apply %skip-list skp ks))
 
-(define (%skip-list skp . ks)
-  (let ((k ;(if (null? ks) 0 (car ks))))
-           (optional ks 0)))
-    (let loop ((node (skipnode-next (skip-start skp) k)) (lst '()))
-      (if (null? node)
-        (reverse lst)
-        (loop (skipnode-next node k) (cons (skipnode-item node) lst))))))
-
 (define-with-contract (skip-max-links skp)
   "maximal number of links"
@@ -360 +482 @@
   (%skip-max-links skp))
 
-(define (%skip-max-links skp)
-  (skipnode-links (skip-start skp)))
-
 (define-with-contract (skip-dups? skp)
   "check if duplicates are allowed"
@@ -368 +487 @@
   (%skip-dups? skp))
 
-(define (%skip-dups? skp)
-  ;; more than one initial comparison operator
-  (not (null? (cdr (%skip-orders skp)))))
-
 (define-with-contract (skip-compare skp)
   "combined numerical comparison procedure"
@@ -377 +492 @@
   (range (procedure? result))
   (%skip-compare skp))
-
-(define (%skip-compare skp)
-  (let loop ((orders (%skip-orders skp)))
-    (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))))))))
 
 (define-with-contract (skip-search! skp item)
@@ -396 +500 @@
   (%skip-search! skp item))
   
-(define (%skip-search! skp item . flags)
-  (let ((lazy? (optional flags #t)) (cursor (skip-cursor skp)))
-    ; the lazy? argument is set to #f in skip-insert! to cope
-    ; with lists which are alreade sorted
-    (let down (
-      (k (- (%skip-links skp) 1))
-      ;(node (skip-start skp))
-      (node (if (and lazy? (skip-lazy? skp item))
-              cursor
-              (skip-start skp)))
-      )
-      (unless (negative? k)
-        (let forward ((node node))
-;(print k " " (skipnode-item node))
-          (let ((next (skipnode-next node k)))
-            (if (skip-in? skp item next)
-              (forward next)
-              (begin
-                (set! (skipnode-next cursor k) node)
-                (down (- k 1) node)))))))))
-
 (define-with-contract (skip-found? skp item)
   "check, if last skip-search! was successfull"
@@ -422 +505 @@
   (range (boolean? result))
   (%skip-found? skp item))
-
-(define (%skip-found? skp item)
-  (let ((node (skipnode-next (skip-cursor skp) 0)))
-    (and (not (null? node))
-         (not (null? (skipnode-next node 0)))
-         (zero? ((%skip-compare skp) item (skipnode-item (skipnode-next node 0)))))))
-
-(define (skip-lazy? skp item)
-  (let ((node (skipnode-next (skip-cursor skp) 0)))
-    (and (not (null? node))
-         (not (keyword? (skipnode-item node)))
-         (positive? ((%skip-compare skp) item (skipnode-item node))))))
-
-(define (skip-in? skp item node)
-  (and (not (null? node))
-       (not (keyword? (skipnode-item node)))
-       (> ((%skip-compare skp) item (skipnode-item node)) 0)))
 
 (define-with-contract (skip-insert! skp . items)
@@ -450 +516 @@
       (loop (cdr items)))))
 
-(define (%skip-insert! skp item)
-  (%skip-search! skp item #f)
-  (unless (and (not (%skip-dups? skp)) (skip-found? skp item))
-    (let ((newlinks (skip-rand skp)) (links (%skip-links skp)))
-      (if (> newlinks links)
-        (set! (%skip-links skp) newlinks))
-      (skipnode-insert! (skip-cursor skp)
-                        (make-skipnode item (make-vector newlinks '())))
-      (set! (%skip-count skp) (+ (%skip-count skp) 1)))))
-
 (define-with-contract (skip-remove! skp . items)
   "remove nodes (one per found item) with items from skiplist"
@@ -469 +525 @@
     (loop (cdr items)))))
   
-(define (%skip-remove! skp item)
-  (skip-search! skp item)
-  (when (skip-found? skp item)
-    (skipnode-remove! (skip-cursor skp) (%skip-links skp))
-    (set! (%skip-count skp) (- (%skip-count skp) 1))))
-
 (define-with-contract (skip-remove-all! skp . items)
   "remove nodes (all per found item) with items from skiplist"
@@ -484 +534 @@
     (loop (cdr items)))))
   
-(define (%skip-remove-all! skp item)
-  (skip-search! skp item)
-  (let loop ((found (skip-found? skp item)))
-    (when found
-      (skipnode-remove! (skip-cursor skp) (%skip-links skp))
-      (set! (%skip-count skp) (- (%skip-count skp) 1))
-      (loop (skip-found? skp item)))))
-
-;;; to skip gap nodes at a time in the 2nd level (link index 1), one
-;;; out of every gap nodes must have at least 2 links. Iterating we
-;;; want one out of every gap^i nodes to have at least i+1 links.
-(define (skip-rand skp)
-  (let ((max-links (%skip-max-links skp)))
-    (if (= max-links 1)
-      1 ; normal list, no randomization
-      (let* (
-        (gap (%skip-gap skp))
-        (M (expt gap max-links))
-        (choice  (+ (random M) 1)) ; 0<=(random M)<M
-        )                          ; 1<=choice<=M
-        (assert (exact? M) "too many links in skip-rand" max-links)
-        (let loop ((links 1) (barrier (quotient M gap)))
-          (if (>= choice barrier)
-            links
-            (loop (+ links 1) (quotient barrier gap))))))))
-
 (define-with-contract (dups x y)
   "trivial numerical comparison operator to allow for duplicates"

release/4/skiplists/trunk/skiplists.setup

@@ -3 +3 @@
 (compile -O2 -s -d1 skiplists.scm -J)
 (compile -O3 -d0 -s skiplists.import.scm)
+(compile -O3 -d0 -s %skiplists.import.scm)
 
 (install-extension
  'skiplists
- '("skiplists.so" "skiplists.import.so")
- '((version "0.5")))
+ '("skiplists.so" "%skiplists.import.so" "skiplists.import.so")
+ '((version "0.6")))