[Wisp-cvs] wisp/modules lists.wim,1.112,1.113

[<di...@us...>]

Update of /cvsroot/wisp/wisp/modules
In directory usw-pr-cvs1:/tmp/cvs-serv4422/modules

Modified Files:
	lists.wim 
Log Message:
Implemented |posq|, |posv|, and |position|.

Index: lists.wim
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/lists.wim,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -d -r1.112 -r1.113
--- lists.wim	26 Aug 2002 16:20:01 -0000	1.112
+++ lists.wim	31 Aug 2002 14:27:46 -0000	1.113
@@ -12,11 +12,11 @@
   alist-cons alist-delete any append! append-reverse! assoc* assq*
   assv* break break! circular-list? concatenate! cons* cons-for-each
   count delete dot-tail dotted-list? drop-right drop-right! drop-while
-  every filter-map fold fold-right iota last list-tabulate
-  list= lset-adjoin lset-diff+intersection lset-difference
-  lset-intersection lset-union lset<= lset= make-list not-cons?
-  partition proper-list? remove reverse! span span! split-at split-at!
-  take take! take-right unzip1 unzip2 unzip3 unzip4 unzip5 xcons zip)
+  every filter-map fold fold-right iota last list-tabulate list=
+  lset-adjoin lset-diff+intersection lset-difference lset-intersection
+  lset-union lset<= lset= make-list not-cons? partition position posq
+  posv proper-list? remove reverse! span span! split-at split-at! take
+  take! take-right unzip1 unzip2 unzip3 unzip4 unzip5 xcons zip)
 ; }}}
 
 ;;;; {{{ Constructors
@@ -472,6 +472,33 @@
 ;;;; {{{ Searching
 
 ; |member|, |memq|, and |memv| are defined in (regular-env)
+
+; {{{ |posq|
+(define (posq obj l)
+  (let (loop (l l) (i 0))
+    (and (not (null? l))
+         (if (eq? obj (car l))
+           i
+           (loop (cdr l) (+ i 1))))))
+; }}}
+
+; {{{ |posv|
+(define (posv obj l)
+  (let (loop (l l) (i 0))
+    (and (not (null? l))
+         (if (eqv? obj (car l))
+           i
+           (loop (cdr l) (+ i 1))))))
+; }}}
+
+; {{{ |position|
+(define (position obj l (=? equal?))
+  (let (loop (l l) (i 0))
+    (and (not (null? l))
+         (if (=? obj (car l))
+           i
+           (loop (cdr l) (+ i 1))))))
+; }}}
 
 ; |find| and |find-tail| are defined in (regular-env)