big sequences refactoring

CHANGES.txt

@@ -1,7 +1,11 @@
 Factor 0.76:
 ------------
 
-+ Runtime and core library:
+- The main focus of this release was getting the UI framework in a state
+  where the graphical listener is usable. This goal has largely been
+  achieved. Many performance problems were fixed, and the listener now
+  supports styled text output, presentations, and an
+  automatically-updated data stack display.
 
 - The number of generations used for garbage collection can now be set
   with the +G command line switch. You must specify at least 2
@@ -10,11 +14,7 @@ Factor 0.76:
 - Only 2 generations are used by default now, since there seems to be no
   performance benefit to having 3 after running some brief benchmarks.
 
-- New words:
+- Many improvements to the matrices library.
-
-  math bitroll ( n s w -- n )
-  unparser hex-string ( str -- str )
-  sequences fourth ( seq -- elt )
 
 - String input streams.
 
@@ -25,8 +25,6 @@ Factor 0.76:
 
 - Improved inspector. Call it with inspect ( obj -- ).
 
-+ Framework
-
 - md5 hashing algorithm in contrib/crypto/ (Doug Coleman).
 
 Factor 0.75:

library/bootstrap/boot-stage1.factor

@@ -30,17 +30,19 @@ parser prettyprint sequences io vectors words ;
         "/library/math/complex.factor"
 
         "/library/collections/cons.factor"
-        "/library/collections/assoc.factor"
-        "/library/collections/lists.factor"
         "/library/collections/vectors.factor"
+        "/library/collections/sequences-epilogue.factor"
         "/library/collections/strings.factor"
         "/library/collections/sbuf.factor"
-        "/library/collections/sequences-epilogue.factor"
+        "/library/collections/assoc.factor"
+        "/library/collections/lists.factor"
         "/library/collections/hashtables.factor"
         "/library/collections/namespaces.factor"
         "/library/collections/vectors-epilogue.factor"
+        "/library/collections/sequence-eq.factor"
         "/library/collections/slicing.factor"
         "/library/collections/strings-epilogue.factor"
+        "/library/collections/tree-each.factor"
 
         "/library/math/matrices.factor"
 

library/bootstrap/boot-stage2.factor

@@ -4,6 +4,8 @@ USING: alien assembler command-line compiler generic hashtables
 kernel lists memory namespaces parser sequences io unparser
 words ;
 
+\ fiber? t "inline" set-word-prop
+
 : pull-in ( ? list -- )
     swap [
         [

library/collections/assoc.factor

@@ -10,13 +10,13 @@ IN: lists USING: kernel sequences ;
 
 : assoc* ( key alist -- [[ key value ]] )
     #! Look up a key/value pair.
-    [ car = ] some-with?  car ;
+    [ car = ] find-with nip ;
 
 : assoc ( key alist -- value ) assoc* cdr ;
 
 : assq* ( key alist -- [[ key value ]] )
     #! Looks up a key/value pair using identity comparison.
-    [ car eq? ] some-with?  car ;
+    [ car eq? ] find-with nip ;
 
 : assq ( key alist -- value ) assq* cdr ;
 
@@ -43,16 +43,3 @@ IN: lists USING: kernel sequences ;
     swap [
         unswons rot assoc* dup [ cdr call ] [ 2drop ] ifte
     ] each-with ;
-
-: 2cons ( car1 car2 cdr1 cdr2 -- cons1 cons2 )
-    rot swons >r cons r> ;
-
-: zip ( list list -- list )
-    #! Make a new list containing pairs of corresponding
-    #! elements from the two given lists.
-    2dup and [ 2uncons zip >r cons r> cons ] [ 2drop [ ] ] ifte ;
-
-: unzip ( assoc -- keys values )
-    #! Split an association list into two lists of keys and
-    #! values.
-    [ uncons >r uncons r> unzip 2cons ] [ [ ] [ ] ] ifte* ;

library/collections/cons.factor

@@ -8,112 +8,79 @@ IN: lists USING: generic kernel sequences ;
 
 DEFER: cons?
 BUILTIN: cons 2 cons? [ 0 "car" f ] [ 1 "cdr" f ] ;
-UNION: general-list f cons ;
 
 ! We borrow an idiom from Common Lisp. The car/cdr of an empty
 ! list is the empty list.
 M: f car ;
 M: f cdr ;
 
+UNION: general-list f cons ;
+
 GENERIC: >list ( seq -- list )
 M: general-list >list ( list -- list ) ;
 
-: swons ( cdr car -- [[ car cdr ]] )
-    #! Push a new cons cell. If the cdr is f or a proper list,
-    #! has the effect of prepending the car to the cdr.
-    swap cons ;
-
-: uncons ( [[ car cdr ]] -- car cdr )
-    #! Push both the head and tail of a list.
-    dup car swap cdr ;
-
-: unit ( a -- [ a ] )
-    #! Construct a proper list of one element.
-    f cons ;
-
-: unswons ( [[ car cdr ]] -- cdr car )
-    #! Push both the head and tail of a list.
-    dup cdr swap car ;
-
-: 2car ( cons cons -- car car )
-    swap car swap car ;
-
-: 2cdr ( cons cons -- car car )
-    swap cdr swap cdr ;
-
-: 2uncons ( cons1 cons2 -- car1 car2 cdr1 cdr2 )
-    [ 2car ] 2keep 2cdr ;
-
 : last ( list -- last )
     #! Last cons of a list.
     dup cdr cons? [ cdr last ] when ;
 
-M: cons peek ( list -- last )
-    #! Last element of a list.
-    last car ;
-
 PREDICATE: general-list list ( list -- ? )
     #! Proper list test. A proper list is either f, or a cons
     #! cell whose cdr is a proper list.
     dup [ last cdr ] when not ;
 
-: all? ( list pred -- ? )
+: uncons ( [[ car cdr ]] -- car cdr ) dup car swap cdr ;
-    #! Push if the predicate returns true for each element of
+: unswons ( [[ car cdr ]] -- cdr car ) dup cdr swap car ;
-    #! the list.
+
-    over [
+: swons ( cdr car -- [[ car cdr ]] ) swap cons ;
-        dup >r swap uncons >r swap call [
+: unit ( a -- [ a ] ) f cons ;
-            r> r> all?
+: 2list ( a b -- [ a b ] ) unit cons ;
-        ] [
+: 3list ( a b c -- [ a b c ] ) 2list cons ;
-            r> drop r> drop f
+: 2unlist ( [ a b ] -- a b ) uncons car ;
-        ] ifte
+: 3unlist ( [ a b c ] -- a b c ) uncons uncons car ;
-    ] [
+
+: 2car ( cons cons -- car car ) swap car swap car ;
+: 2cdr ( cons cons -- car car ) swap cdr swap cdr ;
+: 2cons ( ca1 ca2 cd1 cd2 -- c1 c2 ) rot swons >r cons r> ;
+: 2uncons ( c1 c2 -- ca1 ca2 cd1 cd2 ) [ 2car ] 2keep 2cdr ;
+
+: zip ( list list -- list )
+    #! Make a new list containing pairs of corresponding
+    #! elements from the two given lists.
+    2dup and [ 2uncons zip >r cons r> cons ] [ 2drop [ ] ] ifte ;
+
+: unzip ( assoc -- keys values )
+    #! Split an association list into two lists of keys and
+    #! values.
+    [ uncons >r uncons r> unzip 2cons ] [ [ ] [ ] ] ifte* ;
+
+: unpair ( list -- list1 list2 )
+    [ uncons uncons unpair rot swons >r cons r> ] [ f f ] ifte* ;
+
+: <queue> ( -- queue )
+    #! Make a new functional queue.
+    [[ [ ] [ ] ]] ;
+
+: queue-empty? ( queue -- ? )
+    uncons or not ;
+
+: enque ( obj queue -- queue )
+    uncons >r cons r> cons ;
+
+: deque ( queue -- obj queue )
+    uncons
+    [ uncons swapd cons ] [ reverse uncons f swons ] ifte* ;
+
+M: cons = ( obj cons -- ? )
+    2dup eq? [
         2drop t
-    ] ifte ; inline
-
-: all-with? ( obj list pred -- ? )
-    swap [ with rot ] all? 2nip ; inline
-
-: (each) ( list quot -- list quot )
-    [ >r car r> call ] 2keep >r cdr r> ; inline
-
-M: f each ( list quot -- ) 2drop ;
-
-M: cons each ( list quot -- | quot: elt -- ) (each) each ;
-
-M: cons tree-each ( cons quot -- )
-    >r uncons r> tuck >r >r tree-each r> r> tree-each ;
-
-: subset ( list quot -- list )
-    #! Applies a quotation with effect ( X -- ? ) to each
-    #! element of a list; all elements for which the quotation
-    #! returned a value other than f are collected in a new
-    #! list.
-    over [
-        over car >r (each)
-        rot >r subset r> [ r> swons ] [ r> drop ] ifte
     ] [
-        drop
+        over cons? [
-    ] ifte ; inline
+            2dup 2car = >r 2cdr = r> and
-
-: subset-with ( obj list quot -- list )
-    swap [ with rot ] subset 2nip ; inline
-
-: some? ( list pred -- ? )
-    #! Apply predicate with stack effect ( elt -- ? ) to each
-    #! element, return remainder of list from first occurrence
-    #! where it is true, or return f.
-    over [
-        dup >r over >r >r car r> call [
-            r> r> drop
         ] [
-            r> cdr r> some?
+            2drop f
         ] ifte
-    ] [
+    ] ifte ;
-        2drop f
-    ] ifte ; inline
 
-: some-with? ( obj list pred -- ? )
+M: f = ( obj f -- ? ) eq? ;
-    #! Apply predicate with stack effect ( obj elt -- ? ) to
+
-    #! each element, return remainder of list from first
+M: cons hashcode ( cons -- hash ) car hashcode ;
-    #! occurrence where it is true, or return f.
-    swap [ with rot ] some? 2nip ; inline

library/collections/lists.factor

@@ -9,25 +9,33 @@ M: cons length cdr length 1 + ;
 M: f empty? drop t ;
 M: cons empty? drop f ;
 
-: 2list ( a b -- [ a b ] )
+M: cons peek ( list -- last )
-    unit cons ;
+    #! Last element of a list.
+    last car ;
 
-: 2unlist ( [ a b ] -- a b )
+: (each) ( list quot -- list quot )
-    uncons car ;
+    [ >r car r> call ] 2keep >r cdr r> ; inline
 
-: 3list ( a b c -- [ a b c ] )
+M: f each ( list quot -- ) 2drop ;
-    2list cons ;
 
-: 3unlist ( [ a b c ] -- a b c )
+M: cons each ( list quot -- | quot: elt -- ) (each) each ;
-    uncons uncons car ;
 
-M: general-list contains? ( obj list -- ? )
+: (list-find) ( list quot i -- i elt )
-    #! Test if a list contains an element equal to an object.
+    pick [
-    [ = ] some-with? >boolean ;
+        >r 2dup >r >r >r car r> call [
+            r> car r> drop r> swap
+        ] [
+            r> cdr r> r> 1 + (list-find)
+        ] ifte
+    ] [
+        3drop -1 f
+    ] ifte ; inline
 
-: memq? ( obj list -- ? )
+M: general-list find ( list quot -- i elt )
-    #! Test if a list contains an object.
+    0 (list-find) ;
-    [ eq? ] some-with? >boolean ;
+
+M: general-list find* ( start list quot -- i elt )
+    >r tail r> find ;
 
 : partition-add ( obj ? ret1 ret2 -- ret1 ret2 )
     rot [ swapd cons ] [ >r cons r> ] ifte ;
@@ -61,7 +69,7 @@ M: general-list contains? ( obj list -- ? )
 : unique ( elem list -- list )
     #! Prepend an element to a list if it does not occur in the
     #! list.
-    2dup contains? [ nip ] [ cons ] ifte ;
+    2dup member? [ nip ] [ cons ] ifte ;
 
 M: general-list reverse ( list -- list )
     [ ] [ swons ] reduce ;
@@ -71,38 +79,10 @@ M: f map ( list quot -- list ) drop ;
 M: cons map ( list quot -- list | quot: elt -- elt )
     (each) rot >r map r> swons ;
 
-: remove ( obj list -- list )
+IN: sequences
-    #! Remove all occurrences of objects equal to this one from
+DEFER: <range>
-    #! the list.
-    [ = not ] subset-with ;
 
-: remq ( obj list -- list )
+IN: lists
-    #! Remove all occurrences of the object from the list.
-    [ eq? not ] subset-with ;
-
-: prune ( list -- list )
-    #! Remove duplicate elements.
-    dup [ uncons prune unique ] when ;
-
-: fiber? ( list quot -- ? | quot: elt elt -- ? )
-    #! Check if all elements in the list are equivalent under
-    #! the relation.
-    over [ >r uncons r> all-with? ] [ 2drop t ] ifte ; inline
-
-M: cons = ( obj cons -- ? )
-    2dup eq? [
-        2drop t
-    ] [
-        over cons? [
-            2dup 2car = >r 2cdr = r> and
-        ] [
-            2drop f
-        ] ifte
-    ] ifte ;
-
-M: f = ( obj f -- ? ) eq? ;
-
-M: cons hashcode ( cons -- hash ) car hashcode ;
 
 : count ( n -- [ 0 ... n-1 ] )
     0 swap <range> >list ;
@@ -113,6 +93,11 @@ M: cons hashcode ( cons -- hash ) car hashcode ;
 : project-with ( elt n quot -- list )
     swap [ with rot ] project 2nip ; inline
 
+: seq-transpose ( seq -- list )
+    #! An example illustrates this word best:
+    #! [ [ 1 2 3 ] [ 4 5 6 ] ] ==> [ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]
+    dup first length [ swap [ nth ] map-with ] project-with ;
+
 M: general-list head ( n list -- list )
     #! Return the first n elements of the list.
     over 0 > [
@@ -127,38 +112,3 @@ M: general-list tail ( n list -- tail )
 
 M: general-list nth ( n list -- element )
     over 0 number= [ nip car ] [ >r 1 - r> cdr nth ] ifte ;
-
-: intersection ( list list -- list )
-    #! Make a list of elements that occur in both lists.
-    [ swap contains? ] subset-with ;
-
-: difference ( list1 list2 -- list )
-    #! Make a list of elements that occur in list2 but not
-    #! list1.
-    [ swap contains? not ] subset-with ;
-
-: diffq ( list1 list2 -- list )
-    #! Make a list of elements that occur in list2 but not
-    #! list1.
-    [ swap memq? not ] subset-with ;
-
-: contained? ( list1 list2 -- ? )
-    #! Is every element of list1 in list2?
-    swap [ swap contains? ] all-with? ;
-
-: unpair ( list -- list1 list2 )
-    [ uncons uncons unpair rot swons >r cons r> ] [ f f ] ifte* ;
-
-: <queue> ( -- queue )
-    #! Make a new functional queue.
-    [[ [ ] [ ] ]] ;
-
-: queue-empty? ( queue -- ? )
-    uncons or not ;
-
-: enque ( obj queue -- queue )
-    uncons >r cons r> cons ;
-
-: deque ( queue -- obj queue )
-    uncons
-    [ uncons swapd cons ] [ reverse uncons f swons ] ifte* ;

library/collections/namespaces.factor

@@ -144,7 +144,7 @@ SYMBOL: building
     make-sbuf >string ; inline
 
 : make-rstring ( quot -- string )
-    make-sbuf dup nreverse >string ; inline
+    make-sbuf <reversed> >string ; inline
 
 ! Building hashtables, and computing a transitive closure.
 SYMBOL: hash-buffer

library/collections/sequence-eq.factor

@@ -0,0 +1,33 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: sequences
+USING: kernel kernel-internals lists math strings vectors ;
+
+! Note that the sequence union does not include lists, or user
+! defined tuples that respond to the sequence protocol.
+UNION: sequence array string sbuf vector ;
+
+: length= ( seq seq -- ? ) length swap length number= ;
+
+: (sequence=) ( seq seq i -- ? )
+    over length over number= [
+        3drop t
+    ] [
+        3dup 2nth = [ 1 + (sequence=) ] [ 3drop f ] ifte
+    ] ifte ;
+
+: sequence= ( seq seq -- ? )
+    #! Check if two sequences have the same length and elements,
+    #! but not necessarily the same class.
+    over general-list? over general-list? or [
+        swap >list swap >list =
+    ] [
+        2dup length= [ 0 (sequence=) ] [ 2drop f ] ifte
+    ] ifte ;
+
+M: sequence = ( obj seq -- ? )
+    2dup eq? [
+        2drop t
+    ] [
+        over type over type eq? [ sequence= ] [ 2drop f ] ifte
+    ] ifte ;

library/collections/sequences-epilogue.factor

@@ -4,39 +4,24 @@ IN: sequences
 USING: generic kernel kernel-internals lists math strings
 vectors ;
 
-! This is loaded once everything else is available.
+! A reversal of an underlying sequence.
+TUPLE: reversed ;
+C: reversed [ set-delegate ] keep ;
+: reversed@ delegate [ length swap - 1 - ] keep ;
+M: reversed nth ( n seq -- elt ) reversed@ nth ;
+M: reversed set-nth ( elt n seq -- ) reversed@ set-nth ;
 
-! Note that the sequence union does not include lists, or user
+! A repeated sequence is the same element n times.
-! defined tuples that respond to the sequence protocol.
+TUPLE: repeated length object ;
-UNION: sequence array string sbuf vector ;
+M: repeated length repeated-length ;
-
+M: repeated nth nip repeated-object ;
-M: object thaw clone ;
-
-M: object like drop ;
-
-M: object empty? ( seq -- ? ) length 0 = ;
-
-: (>list) ( n i seq -- list )
-    pick pick <= [
-        3drop [ ]
-    ] [
-        2dup nth >r >r 1 + r> (>list) r> swons
-    ] ifte ;
-
-M: object >list ( seq -- list ) dup length 0 rot (>list) ;
-
-: 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ;
 
 ! Combinators
-M: object each ( quot seq -- )
+M: object each ( seq quot -- )
     swap dup length [
         [ swap nth swap call ] 3keep
     ] repeat 2drop ;
 
-M: object tree-each call ;
-
-M: sequence tree-each swap [ swap tree-each ] each-with ;
-
 : change-nth ( seq i quot -- )
     pick pick >r >r >r swap nth r> call r> r> swap set-nth ;
     inline
@@ -52,9 +37,6 @@ M: sequence tree-each swap [ swap tree-each ] each-with ;
     #! Destructive on seq.
     0 swap (nmap) ; inline
 
-: immutable ( seq quot -- seq | quot: seq -- )
-    swap [ thaw ] keep >r dup >r swap call r> r> like ; inline
-
 M: object map ( seq quot -- seq | quot: elt -- elt )
     swap [ swap nmap ] immutable ;
 
@@ -70,26 +52,94 @@ M: object map ( seq quot -- seq | quot: elt -- elt )
 M: object 2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 )
     swap [ swap 2nmap ] immutable ;
 
-! Operations
+M: object find* ( i seq quot -- i elt  )
-: index* ( obj seq i -- n )
+    pick pick length >= [
-    #! The index of the object in the sequence, starting from i.
+        3drop -1 f
-    over length over <= [
-        3drop -1
     ] [
-        3dup swap nth = [ 2nip ] [ 1 + index* ] ifte
+        3dup >r >r >r >r nth r> call [
+            r> dup r> nth r> drop
+        ] [
+            r> 1 + r> r> find*
+        ] ifte
     ] ifte ;
 
+M: object find ( seq quot -- i elt )
+    0 -rot find* ;
+
+: contains? ( seq quot -- ? )
+    find drop -1 > ; inline
+
+: contains-with? ( obj seq quot -- ? )
+    find-with drop -1 > ; inline
+
+: all? ( seq quot -- ? )
+    #! ForAll(P in X) <==> !Exists(!P in X)
+    swap [ swap call not ] contains-with? not ; inline
+
+: all-with? ( obj list pred -- ? )
+    swap [ with rot ] all? 2nip ; inline
+
+: subset ( seq quot -- seq | quot: elt -- ? )
+    #! all elements for which the quotation returned a value
+    #! other than f are collected in a new list.
+    swap [
+        dup length <vector> -rot [
+            rot >r 2dup >r >r swap call [
+                r> r> r> [ push ] keep swap
+            ] [
+                r> r> drop r> swap
+            ] ifte
+        ] each drop
+    ] keep like ; inline
+
+: subset-with ( obj list quot -- list )
+    swap [ with rot ] subset 2nip ; inline
+
+: fiber? ( seq quot -- ? | quot: elt elt -- ? )
+    #! Tests if all elements are equivalent under the relation.
+    over empty?
+    [ >r [ first ] keep r> all-with? ] [ 2drop t ] ifte ; inline
+
+! Operations
+M: object thaw clone ;
+
+M: object like drop ;
+
+M: object empty? ( seq -- ? ) length 0 = ;
+
+: (>list) ( n i seq -- list )
+    pick pick <= [
+        3drop [ ]
+    ] [
+        2dup nth >r >r 1 + r> (>list) r> swons
+    ] ifte ;
+
+M: object >list ( seq -- list ) dup length 0 rot (>list) ;
+
+: index* ( obj i seq -- n )
+    #! The index of the object in the sequence, starting from i.
+    [ = ] find-with* drop ;
+
 : index ( obj seq -- n )
     #! The index of the object in the sequence.
-    0 index* ;
+    [ = ] find-with drop ;
 
-M: object contains? ( obj seq -- ? )
+: member? ( obj seq -- ? )
     #! Tests for membership using =.
-    index -1 > ;
+    [ = ] contains-with? ;
 
-: push ( element sequence -- )
+: memq? ( obj seq -- ? )
-    #! Push a value on the end of a sequence.
+    #! Tests for membership using eq?
-    dup length swap set-nth ;
+    [ eq? ] contains-with? ;
+
+: remove ( obj list -- list )
+    #! Remove all occurrences of objects equal to this one from
+    #! the list.
+    [ = not ] subset-with ;
+
+: remq ( obj list -- list )
+    #! Remove all occurrences of the object from the list.
+    [ eq? not ] subset-with ;
 
 : nappend ( s1 s2 -- )
     #! Destructively append s2 to s1.
@@ -123,68 +173,36 @@ M: object peek ( sequence -- element )
     #! Get value at end of sequence and remove it.
     dup peek >r dup length 1 - swap set-length r> ;
 
+: push-new ( elt seq -- )
+    2dup member? [ 2drop ] [ push ] ifte ;
+
+: prune ( seq -- seq )
+    [
+        dup length <vector> swap [ over push-new ] each
+    ] keep like ;
+
 : >pop> ( stack -- stack ) dup pop drop ;
 
-: (exchange) ( seq i j -- seq[i] j seq )
+M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
-    pick >r >r swap nth r> r> ;
 
-: exchange ( seq i j -- )
+! Set theoretic operations
-    #! Exchange seq[i] and seq[j].
+: seq-intersect ( seq seq -- seq )
-    [ (exchange) ] 3keep swap (exchange) set-nth set-nth ;
+    #! Make a list of elements that occur in both lists.
+    [ swap member? ] subset-with ;
 
-: (nreverse) ( seq i -- )
+: seq-diff ( list1 list2 -- list )
-    #! Swap seq[i] with seq[length-i-1].
+    #! Make a list of elements that occur in list2 but not
-    over length over - 1 - exchange ;
+    #! list1.
+    [ swap member? not ] subset-with ;
 
-: nreverse ( seq -- )
+: seq-diffq ( list1 list2 -- list )
-    #! Destructively reverse seq.
+    #! Make a list of elements that occur in list2 but not
-    dup length 2 /i [ 2dup (nreverse) ] repeat drop ;
+    #! list1.
+    [ swap memq? not ] subset-with ;
 
-M: object reverse ( seq -- seq ) [ nreverse ] immutable ;
+: contained? ( list1 list2 -- ? )
-
+    #! Is every element of list1 in list2?
-! Equality testing
+    swap [ swap member? ] all-with? ;
-: length= ( seq seq -- ? ) length swap length number= ;
-
-: (sequence=) ( seq seq i -- ? )
-    over length over number= [
-        3drop t
-    ] [
-        3dup 2nth = [
-            1 + (sequence=)
-        ] [
-            3drop f
-        ] ifte
-    ] ifte ;
-
-: sequence= ( seq seq -- ? )
-    #! Check if two sequences have the same length and elements,
-    #! but not necessarily the same class.
-    over general-list? over general-list? or [
-        swap >list swap >list =
-    ] [
-        2dup length= [ 0 (sequence=) ] [ 2drop f ] ifte
-    ] ifte ;
-
-M: sequence = ( obj seq -- ? )
-    2dup eq? [
-        2drop t
-    ] [
-        over type over type eq? [
-            sequence=
-        ] [
-            2drop f
-        ] ifte
-    ] ifte ;
-
-! A repeated sequence is the same element n times.
-TUPLE: repeated length object ;
-M: repeated length repeated-length ;
-M: repeated nth nip repeated-object ;
-
-: seq-transpose ( list -- list )
-    #! An example illustrates this word best:
-    #! [ [ 1 2 3 ] [ 4 5 6 ] ] ==> [ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]
-    0 over nth length [ swap [ nth ] map-with ] project-with ;
 
 IN: kernel
 

library/collections/sequences.factor

@@ -20,7 +20,6 @@ GENERIC: thaw ( seq -- mutable-seq )
 GENERIC: like ( seq seq -- seq )
 GENERIC: reverse ( seq -- seq )
 GENERIC: peek ( seq -- elt )
-GENERIC: contains? ( elt seq -- ? )
 GENERIC: head ( n seq -- seq )
 GENERIC: tail ( n seq -- seq )
 GENERIC: concat ( seq -- seq )
@@ -35,12 +34,6 @@ G: each ( seq quot -- | quot: elt -- )
 : reduce ( list identity quot -- value | quot: x y -- z )
     swapd each ; inline
 
-G: tree-each ( obj quot -- | quot: elt -- )
-    [ over ] [ type ] ; inline
-
-: tree-each-with ( obj vector quot -- )
-    swap [ with ] tree-each 2drop ; inline
-
 G: map ( seq quot -- seq | quot: elt -- elt )
     [ over ] [ type ] ; inline
 
@@ -53,15 +46,30 @@ G: map ( seq quot -- seq | quot: elt -- elt )
 G: 2map ( seq seq quot -- seq | quot: elt elt -- elt )
     [ over ] [ type ] ; inline
 
-DEFER: <range>
+G: find [ over ] [ type ] ; inline
-DEFER: append ! remove this when sort is moved from lists to sequences
+
-DEFER: subseq
+: find-with ( obj seq quot -- i elt )
+    swap [ with rot ] find 2swap 2drop ; inline
+
+G: find* [ over ] [ type ] ; inline
+
+: find-with* ( obj i seq quot -- i elt )
+    -rot [ with rot ] find* 2swap 2drop ; inline
+
+: immutable ( seq quot -- seq | quot: seq -- )
+    swap [ thaw ] keep >r dup >r swap call r> r> like ; inline
 
 : first 0 swap nth ; inline
 : second 1 swap nth ; inline
 : third 2 swap nth ; inline
 : fourth 3 swap nth ; inline
 
+: push ( element sequence -- )
+    #! Push a value on the end of a sequence.
+    dup length swap set-nth ;
+
+: 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ;
+
 : 2unseq ( { x y } -- x y )
     dup first swap second ;
 

library/collections/strings.factor

@@ -30,7 +30,7 @@ M: string >string ;
     string-compare 0 > ;
 
 ! Characters
-PREDICATE: integer blank     " \t\n\r" contains? ;
+PREDICATE: integer blank     " \t\n\r" member? ;
 PREDICATE: integer letter    CHAR: a CHAR: z between? ;
 PREDICATE: integer LETTER    CHAR: A CHAR: Z between? ;
 PREDICATE: integer digit     CHAR: 0 CHAR: 9 between? ;
@@ -39,7 +39,7 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
 : quotable? ( ch -- ? )
     #! In a string literal, can this character be used without
     #! escaping?
-    dup printable? swap "\"\\" contains? not and ;
+    dup printable? swap "\"\\" member? not and ;
 
 : url-quotable? ( ch -- ? )
     #! In a URL, can this character be used without
@@ -47,4 +47,4 @@ PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
     dup letter?
     over LETTER? or
     over digit? or
-    swap "/_?." contains? or ;
+    swap "/_?." member? or ;

library/collections/tree-each.factor

@@ -0,0 +1,17 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: sequences
+USING: generic kernel lists ;
+
+G: tree-each ( obj quot -- | quot: elt -- )
+    [ over ] [ type ] ; inline
+
+: tree-each-with ( obj vector quot -- )
+    swap [ with ] tree-each 2drop ; inline
+
+M: object tree-each call ;
+
+M: sequence tree-each swap [ swap tree-each ] each-with ;
+
+M: cons tree-each ( cons quot -- )
+    >r uncons r> tuck >r >r tree-each r> r> tree-each ;

library/collections/vectors-epilogue.factor

@@ -26,8 +26,10 @@ M: general-list like drop >list ;
 
 M: vector like drop >vector ;
 
-: 3vector ( x y z -- { x y z } )
+: (1vector) [ push ] keep ; inline
-    3 <vector>
+: (2vector) [ swapd push ] keep (1vector) ; inline
-    [ >r rot r> push ] keep
+: (3vector) [ >r rot r> push ] keep (2vector) ; inline
-    [ swapd push ] keep
+
-    [ push ] keep ;
+: 1vector ( x -- { x } ) 1 <vector> (1vector) ;
+: 2vector ( x y -- { x y } ) 2 <vector> (2vector) ;
+: 3vector ( x y z -- { x y z } ) 3 <vector> (3vector) ;

library/compiler/optimizer.factor

@@ -108,7 +108,7 @@ M: #push can-kill* ( literal node -- ? )
     2drop t ;
 
 M: #push kill-node* ( literals node -- )
-    [ node-out-d diffq ] keep set-node-out-d ;
+    [ node-out-d seq-diffq ] keep set-node-out-d ;
 
 M: #push useless-node? ( node -- ? )
     node-out-d empty? ;
@@ -118,7 +118,7 @@ M: #drop can-kill* ( literal node -- ? )
      2drop t ;
 
 M: #drop kill-node* ( literals node -- )
-    [ node-in-d diffq ] keep set-node-in-d ;
+    [ node-in-d seq-diffq ] keep set-node-in-d ;
 
 M: #drop useless-node? ( node -- ? )
     node-in-d empty? ;

library/compiler/simplifier.factor

@@ -35,7 +35,7 @@ M: tuple simplify-node drop f ;
     ] with-scope  [ simplify ] when ;
 
 : label-called? ( label -- ? )
-    simplifying get [ calls-label? ] some-with? ;
+    simplifying get [ calls-label? ] contains-with? ;
 
 M: %label simplify-node ( linear vop -- linear ? )
     vop-label label-called? [ f ] [ cdr t ] ifte ;
@@ -93,11 +93,11 @@ M: %tag-fixnum simplify-node ( linear vop -- linear ? )
     #! current basic block. Outputs a true value if the vreg
     #! is not read or written before the end of the basic block.
     [
-        2dup vop-inputs contains? [
+        2dup vop-inputs member? [
             ! we are reading the vreg
             2drop t f
         ] [
-            2dup vop-outputs contains? [
+            2dup vop-outputs member? [
                 ! we are writing the vreg
                 2drop f f
             ] [
@@ -172,10 +172,16 @@ M: %replace-d simplify-node ( linear vop -- linear ? )
 M: fast-branch simplify-node ( linear vop -- linear ? )
     class fast-branch make-fast-branch ;
 
+: ?label ( symbol linear -- ? )
+    car dup %label? [ vop-label = ] [ 2drop f ] ifte ;
+
+: (find-label) ( label linear -- linear )
+    dup
+    [ 2dup ?label [ nip ] [ cdr (find-label) ] ifte ]
+    [ 2drop f ] ifte ;
+
 : find-label ( label -- rest )
-    simplifying get [
+    simplifying get (find-label) ;
-        dup %label? [ vop-label = ] [ 2drop f ] ifte
-    ] some-with? ;
 
 M: %label next-logical ( linear vop -- linear )
     drop cdr dup car next-logical ;

library/compiler/xt.factor

@@ -124,7 +124,7 @@ M: absolute-16/16 fixup ( absolute -- ) >absolute fixup-16/16 ;
     dup compiled? [
         drop t
     ] [
-        dup compile-words get contains? [
+        dup compile-words get member? [
             drop t
         ] [
             compiled-xts get assoc

library/generic/complement.factor

@@ -11,7 +11,7 @@ SYMBOL: complement
 complement [
     "complement" word-prop builtin-supertypes
     num-types count
-    difference
+    seq-diff
 ] "builtin-supertypes" set-word-prop
 
 complement [

library/generic/generic.factor

@@ -184,7 +184,7 @@ SYMBOL: object
     #! Return a class that is a subclass of both, or null in
     #! the degenerate case.
     swap builtin-supertypes swap builtin-supertypes
-    intersection lookup-union ;
+    seq-intersect lookup-union ;
 
 : define-class ( class metaclass -- )
     dupd "metaclass" set-word-prop

library/httpd/html.factor

@@ -29,9 +29,9 @@ sequences strings styles unparser words ;
     "color: #" % hex-color, "; " % ;
 
 : style-css, ( flag -- )
-    dup [ italic bold-italic ] contains?
+    dup [ italic bold-italic ] member?
     [ "font-style: italic; " % ] when
-    [ bold bold-italic ] contains?
+    [ bold bold-italic ] member?
     [ "font-weight: bold; " % ] when ;
 
 : underline-css, ( flag -- )

library/inference/branches.factor

@@ -5,10 +5,10 @@ USING: errors generic interpreter kernel lists math namespaces
 sequences strings vectors words hashtables prettyprint ;
 
 : longest ( list -- length )
-    0 swap [ length max ] each ;
+    [ length ] map 0 [ max ] reduce ;
 
 : computed-value-vector ( n -- vector )
-    [ drop object <computed> ] project >vector ;
+    empty-vector [ object <computed> ] map ;
 
 : add-inputs ( count stack -- stack )
     #! Add this many inputs to the given stack.

library/inference/inference.factor

@@ -99,7 +99,7 @@ M: object apply-object apply-literal ;
 : handle-terminator ( quot -- )
     #! If the quotation throws an error, do not count its stack
     #! effect.
-    [ terminator? ] some? [ terminate ] when ;
+    [ terminator? ] find drop -1 > [ terminate ] when ;
 
 : infer-quot ( quot -- )
     #! Recursive calls to this word are made for nested

library/io/directories.factor

@@ -20,5 +20,5 @@ sequences strings unparser ;
 : directory. ( dir -- )
     #! If "doc-root" set, create links relative to it.
     dup directory [
-        dup [ "." ".." ] contains? [ 2drop ] [ file. ] ifte
+        dup [ "." ".." ] member? [ 2drop ] [ file. ] ifte
     ] each-with ;

library/io/string-streams.factor

@@ -22,7 +22,7 @@ M: sbuf stream-read ( count sbuf -- string )
     ] ifte ;
 
 : <string-reader> ( string -- stream )
-    >sbuf dup nreverse <line-reader> ;
+    <reversed> >sbuf <line-reader> ;
 
 : string-in ( str quot -- )
     [ swap <string-reader> stdio set call ] with-scope ;

library/syntax/parse-numbers.factor

@@ -32,12 +32,12 @@ GENERIC: str>number ( str -- num )
 
 M: string str>number 10 base> ;
 
-PREDICATE: string potential-ratio CHAR: / swap contains? ;
+PREDICATE: string potential-ratio CHAR: / swap member? ;
 M: potential-ratio str>number ( str -- num )
     dup CHAR: / swap index swap cut*
     swap 10 base> swap 10 base> / ;
 
-PREDICATE: string potential-float CHAR: . swap contains? ;
+PREDICATE: string potential-float CHAR: . swap member? ;
 M: potential-float str>number ( str -- num )
     str>float ;
 

library/syntax/parse-words.factor

@@ -76,7 +76,7 @@ global [ string-mode off ] bind
 
 ! Used by parsing words
 : ch-search ( ch -- index )
-    "line" get "col" get index* ;
+    "col" get "line" get index* ;
 
 : (until) ( index -- str )
     "col" get swap dup 1 + "col" set "line" get subseq ;

library/syntax/unparser.factor

@@ -53,7 +53,7 @@ M: ratio unparse ( num -- str )
 : fix-float ( str -- str )
     #! This is terrible. Will go away when we do our own float
     #! output.
-    CHAR: . over contains? [ ".0" append ] unless ;
+    CHAR: . over member? [ ".0" append ] unless ;
 
 M: float unparse ( float -- str )
     (unparse-float) fix-float ;

library/test/compiler/optimizer.factor

@@ -28,7 +28,7 @@ USE: sequences
 
 [ t ] [
     3 [ 3 over [ ] [ ] ifte drop ] dataflow
-    kill-set [ value= ] some-with? >boolean
+    kill-set [ value= ] contains-with?
 ] unit-test
 
 : literal-kill-test-1 4 compiled-offset cell 2 * - ; compiled

library/test/hashtables.factor

@@ -6,6 +6,7 @@ USE: math
 USE: namespaces
 USE: test
 USE: vectors
+USE: sequences
 
 16 <hashtable> "testhash" set
 

library/test/inference.factor

@@ -211,7 +211,7 @@ M: real iterate drop ;
 
 [ [[ 1 1 ]] ] [ [ length ] infer old-effect ] unit-test
 [ [[ 1 1 ]] ] [ [ reverse ] infer old-effect ] unit-test
-[ [[ 2 1 ]] ] [ [ contains? ] infer old-effect ] unit-test
+[ [[ 2 1 ]] ] [ [ member? ] infer old-effect ] unit-test
 [ [[ 2 1 ]] ] [ [ remove ] infer old-effect ] unit-test
 [ [[ 1 1 ]] ] [ [ prune ] infer old-effect ] unit-test
 

library/test/lists/combinators.factor

@@ -10,12 +10,6 @@ USE: sequences
 [ [ [ 3 2 1 ] [ 5 4 3 ] [ 6 ] ] ]
 [ [ 1 2 3 ] [ 3 4 5 ] [ 6 ] 3list [ reverse ] map ] unit-test
 
-[ f ] [ [ "Hello" { } 4/3 ] [ string? ] all? ] unit-test
-[ t ] [ [ ] [ ] all? ] unit-test
-[ t ] [ [ "hi" t 1/2 ] [ ] all? ] unit-test
-
-[ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] subset ] unit-test
-
 [ [ 43 "a" [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
 
 [ "fdsfs" [ > ] sort ] unit-test-fails
@@ -29,11 +23,4 @@ USE: sequences
 [ t ] [ [ 1/2 ] [ = ] fiber? ] unit-test
 [ t ] [ [ 1.0 10/10 1 ] [ = ] fiber? ] unit-test
 
-[ f ] [ [ ] [ ] some? ] unit-test
-[ t ] [ [ 1 ] [ ] some? >boolean ] unit-test
-[ t ] [ [ 1 2 3 ] [ 2 > ] some? >boolean ] unit-test
-[ f ] [ [ 1 2 3 ] [ 10 > ] some? ] unit-test
-
 [ [ 2 3 4 ] ] [ 1 [ 1 2 3 ] [ + ] map-with ] unit-test
-
-[ [ 3 ] ] [ 2 [ 1 2 3 ] [ < ] subset-with ] unit-test

library/test/lists/lists.factor

@@ -10,11 +10,6 @@ USING: kernel lists sequences test ;
 [ [ 1 2 3 4 ]   ] [ [ 1 2 3 ] [ 4 ] append ] unit-test
 [ [ 1 2 3 4 ]   ] [ [ 1 2 3 ] { 4 } append ] unit-test
 
-[ f         ] [ 3 [ ]     contains? ] unit-test
-[ f         ] [ 3 [ 1 2 ] contains? ] unit-test
-[ t ] [ 1 [ 1 2 ] contains? >boolean ] unit-test
-[ t ] [ 2 [ 1 2 ] contains? >boolean ] unit-test
-
 [ [ 3 ]     ] [ [ 3 ]         last ] unit-test
 [ [ 3 ]     ] [ [ 1 2 3 ]     last ] unit-test
 [ [[ 3 4 ]] ] [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] last ] unit-test
@@ -52,7 +47,7 @@ USING: kernel lists sequences test ;
 [ f ] [ 3 [ 1 2 3 ] tail ] unit-test
 [ [ 3 ] ] [ 2 [ 1 2 3 ] tail ] unit-test
 
-[ [ 1 3 ] ] [ [ 2 ] [ 1 2 3 ] difference ] unit-test
+[ [ 1 3 ] ] [ [ 2 ] [ 1 2 3 ] seq-diff ] unit-test
 
 [ t ] [ [ 1 2 3 ] [ 1 2 3 4 5 ] contained? ] unit-test
 [ f ] [ [ 1 2 3 6 ] [ 1 2 3 4 5 ] contained? ] unit-test

library/test/parsing-word.factor

@@ -14,5 +14,5 @@ DEFER: foo
 ! Test > 1 ( ) comment; only the first one should be used.
 [ t ] [
     CHAR: a "IN: temporary : foo ( a ) ( b ) ;" parse drop word
-    "stack-effect" word-prop contains?
+    "stack-effect" word-prop member?
 ] unit-test

library/test/sequences.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: lists math sequences test vectors ;
+USING: kernel lists math sequences strings test vectors ;
 
 [ [ 1 2 3 4 ] ] [ 1 5 <range> >list ] unit-test
 [ 3 ] [ 1 4 <range> length ] unit-test
@@ -19,3 +19,38 @@ USING: lists math sequences test vectors ;
 
 [ [ 1 1 2 6 24 120 720 ] ]
 [ [ 1 2 3 4 5 6 7 ] 1 [ * ] accumulate ] unit-test
+
+[ -1 f ] [ [ ] [ ] find ] unit-test
+[ 0 1 ] [ [ 1 ] [ ] find ] unit-test
+[ 1 "world" ] [ [ "hello" "world" ] [ "world" = ] find ] unit-test
+[ 2 3 ] [ [ 1 2 3 ] [ 2 > ] find ] unit-test
+[ -1 f ] [ [ 1 2 3 ] [ 10 > ] find ] unit-test
+
+[ 1 CHAR: e ]
+[ "aeiou" "hello world" [ swap member? ] find-with ] unit-test
+
+[ 4 CHAR: o ]
+[ "aeiou" 3 "hello world" [ swap member? ] find-with* ] unit-test
+
+[ f         ] [ 3 [ ]     member? ] unit-test
+[ f         ] [ 3 [ 1 2 ] member? ] unit-test
+[ t ] [ 1 [ 1 2 ] member? ] unit-test
+[ t ] [ 2 [ 1 2 ] member? ] unit-test
+
+[ t ]
+[ [ "hello" "world" ] [ second ] keep memq? ] unit-test
+
+[ 4 ] [ CHAR: x "tuvwxyz" >vector index ] unit-test 
+
+[ -1 ] [ CHAR: x 5 "tuvwxyz" >vector index* ] unit-test 
+
+[ -1 ] [ CHAR: a 0 "tuvwxyz" >vector index* ] unit-test
+
+[ f ] [ [ "Hello" { } 4/3 ] [ string? ] all? ] unit-test
+[ t ] [ [ ] [ ] all? ] unit-test
+[ t ] [ [ "hi" t 1/2 ] [ ] all? ] unit-test
+
+[ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] subset ] unit-test
+[ { 4 2 6 } ] [ { 1 4 2 5 3 6 } [ 2 mod 0 = ] subset ] unit-test
+
+[ [ 3 ] ] [ 2 [ 1 2 3 ] [ < ] subset-with ] unit-test

library/test/strings.factor

@@ -24,7 +24,7 @@ USE: lists
 
 [ "Beginning" ] [ 9 "Beginning and end" head ] unit-test
 
-[ f ] [ CHAR: I "team" contains? ] unit-test
+[ f ] [ CHAR: I "team" member? ] unit-test
 [ t ] [ "ea" "team" subseq? ] unit-test
 [ f ] [ "actore" "Factor" subseq? ] unit-test
 

library/test/vectors.factor

@@ -94,8 +94,6 @@ unit-test
 [ -1 ] [ 5 { } index ] unit-test
 [ 4 ] [ 5 { 1 2 3 4 5 } index ] unit-test
 
-[ { "c" "b" "a" } ] [ { "a" "b" "c" } clone dup 0 2 exchange ] unit-test
-
 [ t ] [
-    100 count dup >vector dup nreverse >list >r reverse r> =
+    100 count dup >vector <reversed> >list >r reverse r> =
 ] unit-test

library/ui/buttons.factor

@@ -4,7 +4,7 @@ IN: gadgets
 USING: generic kernel lists math namespaces prettyprint sdl
 sequences io sequences styles ;
 
-: button-down? ( n -- ? ) hand hand-buttons contains? ;
+: button-down? ( n -- ? ) hand hand-buttons member? ;
 
 : mouse-over? ( gadget -- ? ) hand hand-gadget child? ;
 

library/ui/gadgets.factor

@@ -9,20 +9,20 @@ sequences vectors ;
 ! delegates to its shape.
 TUPLE: gadget paint gestures relayout? root? parent children ;
 
-: gadget-child gadget-children car ;
+: gadget-child gadget-children first ;
 
 C: gadget ( -- gadget )
-    { 0 0 0 } dup <rectangle> over set-delegate
+    { 0 0 0 } dup <rectangle> over set-delegate ;
-    <namespace> over set-gadget-paint
-    <namespace> over set-gadget-gestures ;
 
 TUPLE: plain-gadget ;
 
-C: plain-gadget <gadget> over set-delegate ;
+C: plain-gadget ( -- gadget )
+    <gadget> over set-delegate ;
 
 TUPLE: etched-gadget ;
 
-C: etched-gadget <gadget> over set-delegate ;
+C: etched-gadget ( -- gadget )
+    <gadget> over set-delegate ;
 
 DEFER: add-invalid
 

library/ui/hand.factor

@@ -6,13 +6,8 @@ prettyprint sdl sequences vectors ;
 
 DEFER: pick-up
 
-: (pick-up) ( point list -- gadget )
+: (pick-up) ( point gadget -- gadget )
-    dup [
+    gadget-children <reversed> [ pick-up ] find nip ;
-        2dup car pick-up dup
-        [ 2nip ] [ drop cdr (pick-up) ] ifte
-    ] [
-        2drop f
-    ] ifte ;
 
 : pick-up ( point gadget -- gadget )
     #! The logic is thus. If the point is definately outside the
@@ -20,10 +15,7 @@ DEFER: pick-up
     #! in any subgadget. If not, see if it is contained in the
     #! box delegate.
     2dup inside? [
-        [
+        [ [ translate ] keep (pick-up) dup ] keep ?
-            [ translate ] keep
-            gadget-children reverse (pick-up) dup
-        ] keep ?
     ] [
         2drop f
     ] ifte ;

library/ui/hierarchy.factor

@@ -17,13 +17,15 @@ sequences ;
 
 : clear-gadget ( gadget -- )
     dup gadget-children [ f swap set-gadget-parent ] each
-    f over set-gadget-children relayout ;
+    0 over gadget-children set-length relayout ;
+
+: ?push ( elt seq/f -- seq )
+    [ push ] [ 1vector ] ifte* ;
 
 : (add-gadget) ( gadget box -- )
-    #! This is inefficient.
     over unparent
     dup pick set-gadget-parent
-    [ gadget-children swap add ] keep set-gadget-children ;
+    [ gadget-children ?push ] keep set-gadget-children ;
 
 : add-gadget ( gadget parent -- )
     #! Add a gadget to a parent gadget.

library/ui/layouts.factor

@@ -35,7 +35,7 @@ TUPLE: pack align fill vector ;
     2dup packed-dim-2 swap orient ;
 
 : packed-dims ( gadget sizes -- list )
-    over gadget-children >r (packed-dims) r>
+    over gadget-children >list >r (packed-dims) r>
     zip [ uncons set-gadget-dim ] each ;
 
 : packed-loc-1 ( sizes -- list )
@@ -51,7 +51,7 @@ TUPLE: pack align fill vector ;
     dup packed-loc-1 >r dupd packed-loc-2 r> orient ;
 
 : packed-locs ( gadget sizes -- )
-    over gadget-children >r (packed-locs) r>
+    over gadget-children >list >r (packed-locs) r>
     zip [ uncons set-shape-loc ] each ;
 
 : packed-layout ( gadget sizes -- )

library/win32/win32-io-internals.factor

@@ -35,7 +35,7 @@ SYMBOL: callbacks
 : expected-error? ( -- bool )
     [ 
         ERROR_IO_PENDING ERROR_HANDLE_EOF ERROR_SUCCESS WAIT_TIMEOUT 
-    ] contains? ;
+    ] member? ;
 
 : handle-io-error ( -- )
     GetLastError expected-error? [ win32-throw-error ] unless ;

library/win32/win32-server.factor

@@ -41,7 +41,7 @@ SYMBOL: socket
 : handle-socket-error ( -- )
     WSAGetLastError [
       ERROR_IO_PENDING ERROR_SUCCESS
-    ] contains? [
+    ] member? [
       win32-error-message throw 
     ] unless ;