integers support sequence protocol, remove count, project, project-with, remove zip, clean up a lot of code

library/collections/cons.factor

@@ -43,11 +43,6 @@ PREDICATE: general-list list ( list -- ? )
 : 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.

library/collections/lists.factor

@@ -13,12 +13,10 @@ M: cons peek ( list -- last )
     #! Last element of a list.
     last car ;
 
-: (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 each ( list quot -- | quot: elt -- )
+    [ >r car r> call ] 2keep >r cdr r> each ;
 
 : (list-find) ( list quot i -- i elt )
     pick [
@@ -76,25 +74,6 @@ M: general-list reverse-slice ( list -- list )
 
 M: general-list reverse reverse-slice ;
 
-IN: sequences
-DEFER: <range>
-
-IN: lists
-
-: count ( n -- [ 0 ... n-1 ] )
-    0 swap <range> >list ;
-
-: project ( n quot -- list )
-    >r count r> map ; inline
-
-: 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 > [

library/collections/sequences-epilogue.factor

@@ -234,6 +234,11 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
     #! lexicographically.
     lexi 0 > ;
 
+: 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 ] map-with ;
+
 IN: kernel
 
 : depth ( -- n )

library/generic/builtin.factor

@@ -43,7 +43,8 @@ builtin [ 2drop t ] "class<" set-word-prop
     dup builtin define-class
     dup r> unit "predicate" set-word-prop
     dup builtin-predicate
-    dup r> define-slots
+    dup r> intern-slots 2dup "slots" set-word-prop
+    define-slots
     register-builtin ;
 
 : builtin-type ( n -- symbol ) builtins get nth ;

library/generic/complement.factor

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

library/generic/object.factor

@@ -7,7 +7,7 @@ USING: kernel lists math sequences vectors words ;
 SYMBOL: object
 
 object [
-    drop num-types count
+    drop num-types >list
 ] "builtin-supertypes" set-word-prop
 
 object [

library/generic/slots.factor

@@ -41,8 +41,6 @@ sequences strings words ;
     #! given class. The spec is a list of lists of length 3 of
     #! the form [ slot reader writer ]. slot is an integer,
     #! reader and writer are either words, strings or f.
-    intern-slots
-    2dup "slots" set-word-prop
     [ 3unlist define-slot ] each-with ;
 
 : reader-word ( class name -- word )
@@ -51,17 +49,13 @@ sequences strings words ;
 : writer-word ( class name -- word )
     [ swap "set-" % word-name % "-" % % ] make-string create-in ;
 
-: simple-slot ( class name -- [ reader writer ] )
+: simple-slot ( class name -- reader writer )
-    [ reader-word ] 2keep writer-word 2list ;
+    [ reader-word ] 2keep writer-word ;
 
-: simple-slot-spec ( class slots -- spec )
+: simple-slots ( class slots base -- spec )
-    [ simple-slot ] map-with ;
-
-: simple-slots ( base class slots -- )
     #! Takes a list of slot names, and for each slot name
     #! defines a pair of words <class>-<slot> and 
     #! set-<class>-<slot>. Slot numbering is consecutive and
     #! begins at base.
-    >r tuck r>
+    over length [ + ] map-with
-    simple-slot-spec [ length [ + ] project-with ] keep zip
+    [ >r dupd simple-slot r> -rot 3list ] 2map nip ;
-    define-slots ;

library/generic/tuple.factor

@@ -28,9 +28,6 @@ BUILTIN: tuple 18 tuple? ;
 M: tuple delegate 3 slot ;
 M: tuple set-delegate 3 set-slot ;
 
-#! arrayed objects can be passed to array-nth, and set-array-nth
-UNION: arrayed array tuple ;
-
 : class ( obj -- class )
     #! The class of an object.
     dup tuple? [ class-tuple ] [ type builtin-type ] ifte ;
@@ -76,7 +73,10 @@ UNION: arrayed array tuple ;
 : tuple-slots ( tuple slots -- )
     2dup "slot-names" set-word-prop
     2dup length 2 + "tuple-size" set-word-prop
-    4 -rot simple-slots ;
+    dupd 4 simple-slots
+    2dup { [ 3 delegate set-delegate ] } swap append
+    "slots" set-word-prop
+    define-slots ;
 
 : define-constructor ( word def -- )
     >r [ word-name "in" get constructor-word ] keep [
@@ -85,8 +85,8 @@ UNION: arrayed array tuple ;
 
 : default-constructor ( tuple -- )
     dup [
-        "slots" word-prop
+        "slots" word-prop 1 swap tail-slice reverse-slice
-        reverse [ peek unit , \ keep , ] each
+        [ peek unit , \ keep , ] each
     ] make-list define-constructor ;
 
 : define-tuple ( tuple slots -- )

library/help/tutorial.factor

@@ -275,7 +275,7 @@ M: general-list tutorial-line
             ""
             [ "-1 sqrt ." ]
             ""
-            [ "M[ [ 10 3 ] [ 7 5 ] [ -2 0 ] ]M M[ [ 11 2 ] [ 4 8 ] ]M m." ]
+            [ "M{ { 10 3 } { 7 5 } { -2 0 } }M M{ { 11 2 } { 4 8 } }M m." ]
             ""
             "... and there is much more for the math geeks."
         ] [

library/inference/branches.factor

@@ -31,7 +31,7 @@ sequences strings vectors words hashtables prettyprint ;
 : unify-stacks ( list -- stack )
     #! Replace differing literals in stacks with unknown
     #! results.
-    unify-lengths seq-transpose [ unify-results ] map >vector ; 
+    unify-lengths seq-transpose [ unify-results ] map ;
 
 : balanced? ( list -- ? )
     #! Check if a list of [[ instack outstack ]] pairs is

library/io/binary.factor

@@ -8,5 +8,5 @@ USING: kernel lists math sequences strings ;
 
 : nth-byte ( x n -- b ) -8 * shift HEX: ff bitand ;
 
-: >le ( x n -- string ) [ nth-byte ] project-with >string ;
+: >le ( x n -- string ) [ nth-byte ] map-with >string ;
 : >be ( x n -- string ) >le reverse ;

library/math/integer.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: math
-USING: errors generic kernel math ;
+USING: errors generic kernel math sequences ;
 
 DEFER: fixnum?
 BUILTIN: fixnum 0 fixnum? ;
@@ -105,3 +105,7 @@ M: bignum bitnot bignum-bitnot ;
 M: integer truncate ;
 M: integer floor ;
 M: integer ceiling ;
+
+! Integers support the sequence protocol
+M: integer length ;
+M: integer nth drop ;

library/math/matrices.factor

@@ -184,4 +184,4 @@ M: diagonal nth ( n diag -- n )
 : row-list ( matrix -- list )
     #! A list of lists, where each sublist is a row of the
     #! matrix.
-    dup matrix-rows [ swap <row> >list ] project-with ;
+    dup matrix-rows [ swap <row> >vector ] map-with >list ;

library/syntax/math.factor

@@ -20,9 +20,9 @@ vectors ;
 : BIN: 2 (BASE) ; parsing
 
 ! Matrices
-: M[ f ; parsing
+: M{ f ; parsing
 
-: ]M
+: }M
     reverse
     [ dup length swap car length ] keep
     concat >vector <matrix> swons ; parsing

library/syntax/prettyprint.factor

@@ -53,11 +53,7 @@ M: word prettyprint* ( indent word -- indent )
     ] when* ;
 
 : ?prettyprint-newline ( indent -- )
-    one-line get [
+    one-line get [ bl drop ] [ prettyprint-newline ] ifte ;
-        bl drop
-    ] [
-        prettyprint-newline
-    ] ifte ;
 
 : <prettyprint ( indent -- indent )
     tab-size get + dup ?prettyprint-newline ;
@@ -126,9 +122,9 @@ M: alien prettyprint* ( alien -- str )
     [ over ?prettyprint-newline matrix-rows. ] when* ;
 
 M: matrix prettyprint* ( indent obj -- indent )
-    \ M[ unparse. bl >r 3 + r>
+    \ M{ unparse. bl >r 3 + r>
     row-list matrix-rows.
-    bl \ ]M unparse. 3 - ;
+    bl \ }M unparse. 3 - ;
 
 : prettyprint ( obj -- )
     [

library/test/continuations.factor

@@ -25,7 +25,7 @@ USE: test
         ] with-scope
     ] callcc0 "x" get 5 = ;
 
-[ t ] [ 10 callcc1-test 10 count = ] unit-test
+[ t ] [ 10 callcc1-test 10 >list = ] unit-test
 [ t ] [ callcc-namespace-test ] unit-test
 
 : multishot-test ( -- stack )

library/test/hashtables.factor

@@ -15,7 +15,7 @@ USE: sequences
 1000 [ [ silly-key/value "testhash" get set-hash ] keep ] repeat
 
 [ f ]
-[ 1000 count [ silly-key/value "testhash" get hash = not ] subset ]
+[ 1000 >list [ silly-key/value "testhash" get hash = not ] subset ]
 unit-test
 
 [ t ]

library/test/lists/lists.factor

@@ -38,8 +38,8 @@ USING: kernel lists sequences test ;
 [ [ 1 2 3 ] ] [ 1 [ 1 2 3 ] unique ] unit-test
 [ [ 1 2 3 ] ] [ 2 [ 1 2 3 ] unique ] unit-test
 
-[ [ ]         ] [ 0   count ] unit-test
+[ [ ]         ] [ 0   >list ] unit-test
-[ [ 0 1 2 3 ] ] [ 4   count ] unit-test
+[ [ 0 1 2 3 ] ] [ 4   >list ] unit-test
 
 [ f ] [ 0 f head ] unit-test
 [ f ] [ 0 [ 1 ] head ] unit-test

library/test/lists/queues.factor

@@ -1,7 +1,7 @@
 IN: temporary
 USING: kernel lists math sequences test ;
 
-[ [ 1 2 3 4 5 ] ] [
+[ { 1 2 3 4 5 } ] [
     <queue> [ 1 2 3 4 5 ] [ swap enque ] each
-    5 [ drop deque swap ] project nip
+    5 [ drop deque swap ] map nip
 ] unit-test

library/test/math/matrices.factor

@@ -2,57 +2,57 @@ IN: temporary
 USING: kernel lists math matrices namespaces sequences test
 vectors ;
 
-[ [ [ 1 4 ] [ 2 5 ] [ 3 6 ] ] ]
+[ [ { 1 4 } { 2 5 } { 3 6 } ] ]
-[ M[ [ 1 4 ] [ 2 5 ] [ 3 6 ] ]M row-list ] unit-test
+[ M{ { 1 4 } { 2 5 } { 3 6 } }M row-list ] unit-test
 
 [
-    M[ [ 0 ] [ 0 ] [ 0 ] ]M
+    M{ { 0 } { 0 } { 0 } }M
 ] [
     3 1 <zero-matrix>
 ] unit-test
 
 [
-    M[ [ 1 ] [ 2 ] [ 3 ] ]M
+    M{ { 1 } { 2 } { 3 } }M
 ] [
     { 1 2 3 } <col-matrix>
 ] unit-test
 
 [
-    M[ [ 1 0 0 ]
+    M{ { 1 0 0 }
-       [ 0 1 0 ]
+       { 0 1 0 }
-       [ 0 0 1 ] ]M
+       { 0 0 1 } }M
 ] [
     3 <identity-matrix>
 ] unit-test
 
 [
-    M[ [ 1 0 4 ]
+    M{ { 1 0 4 }
-       [ 0 7 0 ]
+       { 0 7 0 }
-       [ 6 0 3 ] ]M
+       { 6 0 3 } }M
 ] [
-    M[ [ 1 0 0 ]
+    M{ { 1 0 0 }
-       [ 0 2 0 ]
+       { 0 2 0 }
-       [ 0 0 3 ] ]M
+       { 0 0 3 } }M
        
-    M[ [ 0 0 4 ]
+    M{ { 0 0 4 }
-       [ 0 5 0 ]
+       { 0 5 0 }
-       [ 6 0 0 ] ]M
+       { 6 0 0 } }M
 
     m+
 ] unit-test
 
 [
-    M[ [ 1 0 4 ]
+    M{ { 1 0 4 }
-       [ 0 7 0 ]
+       { 0 7 0 }
-       [ 6 0 3 ] ]M
+       { 6 0 3 } }M
 ] [
-    M[ [ 1 0 0 ]
+    M{ { 1 0 0 }
-       [ 0 2 0 ]
+       { 0 2 0 }
-       [ 0 0 3 ] ]M
+       { 0 0 3 } }M
        
-    M[ [ 0 0 -4 ]
+    M{ { 0 0 -4 }
-       [ 0 -5 0 ]
+       { 0 -5 0 }
-       [ -6 0 0 ] ]M
+       { -6 0 0 } }M
 
     m-
 ] unit-test
@@ -64,15 +64,15 @@ vectors ;
 ] unit-test
 
 [
-    M[ [ 6 ] ]M
+    M{ { 6 } }M
 ] [
-    M[ [ 3 ] ]M M[ [ 2 ] ]M m.
+    M{ { 3 } }M M{ { 2 } }M m.
 ] unit-test
 
 [
-    M[ [ 11 ] ]M
+    M{ { 11 } }M
 ] [
-    M[ [ 1 3 ] ]M M[ [ 5 ] [ 2 ] ]M m.
+    M{ { 1 3 } }M M{ { 5 } { 2 } }M m.
 ] unit-test
 
 [
@@ -84,8 +84,8 @@ vectors ;
 [
     { 3 4 }
 ] [
-    M[ [ 1 0 ]
+    M{ { 1 0 }
-       [ 0 1 ] ]M
+       { 0 1 } }M
 
     { 3 4 }
 
@@ -95,8 +95,8 @@ vectors ;
 [
     { 4 3 }
 ] [
-    M[ [ 0 1 ]
+    M{ { 0 1 }
-       [ 1 0 ] ]M
+       { 1 0 } }M
 
     { 3 4 }
 
@@ -107,35 +107,35 @@ vectors ;
 [ { 1 0 0 } ] [ { 0 1 0 } { 0 0 1 } cross ] unit-test
 [ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test
 
-[ M[ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]M ]
+[ M{ { 1 2 } { 3 4 } { 5 6 } }M ]
-[ M[ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]M transpose transpose ]
+[ M{ { 1 2 } { 3 4 } { 5 6 } }M transpose transpose ]
 unit-test
 
-[ M[ [ 1 3 5 ] [ 2 4 6 ] ]M ]
+[ M{ { 1 3 5 } { 2 4 6 } }M ]
-[ M[ [ 1 3 5 ] [ 2 4 6 ] ]M transpose transpose ]
+[ M{ { 1 3 5 } { 2 4 6 } }M transpose transpose ]
 unit-test
 
-[ M[ [ 1 3 5 ] [ 2 4 6 ] ]M ]
+[ M{ { 1 3 5 } { 2 4 6 } }M ]
-[ M[ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]M transpose ]
+[ M{ { 1 2 } { 3 4 } { 5 6 } }M transpose ]
 unit-test
 
 [
-    M[ [ 28 ] ]M
+    M{ { 28 } }M
 ] [
-    M[ [ 2 4 6 ] ]M
+    M{ { 2 4 6 } }M
 
-    M[ [ 1 ]
+    M{ { 1 }
-       [ 2 ]
+       { 2 }
-       [ 3 ] ]M
+       { 3 } }M
     
     m.
 ] unit-test
 
 [
-    [ { 7 } { 4 8 } { 1 5 9 } { 2 6 } { 3 } ]
+    { { 7 } { 4 8 } { 1 5 9 } { 2 6 } { 3 } }
 ] [
-    M[ [ 1 2 3 ] [ 4 5 6 ] [ 7 8 9 ] ]M
+    M{ { 1 2 3 } { 4 5 6 } { 7 8 9 } }M
-    5 [ 2 - swap <diagonal> ] project-with [ >vector ] map
+    5 [ 2 - swap <diagonal> >vector ] map-with
 ] unit-test
 
 [ { t t t } ]

library/test/memory.factor

@@ -2,6 +2,10 @@ IN: temporary
 USING: generic kernel lists math memory words prettyprint 
 sequences test ;
 
+TUPLE: testing x y z ;
+
+[ f 1 2 3 ] [ 1 2 3 <testing> [ ] each-slot ] unit-test
+
 [ ] [
     num-types [
         [

library/test/vectors.factor

@@ -4,7 +4,6 @@ sequences strings test vectors ;
 
 [ 3 ] [ [ t f t ] length ] unit-test
 [ 3 ] [ { t f t } length ] unit-test
-[ 4 length ] unit-test-fails
 
 [ -3 { } nth ] unit-test-fails
 [ 3 { } nth ] unit-test-fails
@@ -20,7 +19,6 @@ sequences strings test vectors ;
 
 [ 1 { } nth ] unit-test-fails
 [ -1 { } set-length ] unit-test-fails
-[ 5 >vector ] unit-test-fails
 [ { } ] [ [ ] >vector ] unit-test
 [ { 1 2 } ] [ [ 1 2 ] >vector ] unit-test
 
@@ -52,7 +50,7 @@ sequences strings test vectors ;
 [ { 1 2 3 4 } ] [ [ { 1 } [ 2 ] { 3 4 } ] concat ] unit-test
 
 [ { "" "a" "aa" "aaa" } ]
-[ 4 [ CHAR: a fill ] project >vector ]
+[ 4 [ CHAR: a fill ] map ]
 unit-test
 
 [ { } ] [ 0 { } tail ] unit-test
@@ -95,5 +93,5 @@ unit-test
 [ 4 ] [ 5 { 1 2 3 4 5 } index ] unit-test
 
 [ t ] [
-    100 count dup >vector <reversed> >list >r reverse r> =
+    100 >list dup >vector <reversed> >list >r reverse r> =
 ] unit-test

library/tools/inspector.factor

@@ -9,17 +9,11 @@ SYMBOL: inspecting
 
 GENERIC: sheet ( obj -- sheet )
 
-: object-sheet ( obj -- names values )
+M: object sheet ( obj -- sheet )
     dup class "slots" word-prop
     [ second ] map
-    tuck [ execute ] map-with ;
+    tuck [ execute ] map-with
-
+    2list ;
-M: object sheet object-sheet 2list ;
-
-M: tuple sheet
-    dup object-sheet
-    >r >r \ delegate swap delegate r> r>
-    2cons 2list ;
 
 PREDICATE: list nonvoid cons? ;
 
@@ -37,7 +31,7 @@ M: hashtable sheet hash>alist unzip 2list ;
     [ swap CHAR: \s pad-right ] map-with ;
 
 : format-sheet ( sheet -- list )
-    dup first length count swons
+    dup first length >vector swons
     dup peek over first [ set ] 2each
     [ column ] map
     seq-transpose

library/tools/memory.factor

@@ -52,25 +52,15 @@ vectors words ;
         ] each-object drop
     ] make-list ;
 
-GENERIC: (each-slot) ( quot obj -- ) inline
+G: each-slot ( obj quot -- ) [ over ] [ type ] ; inline
 
-M: arrayed (each-slot) ( quot array -- )
+M: array each-slot ( array quot -- ) each ;
-    dup array-capacity [
-        [
-            ( quot obj n -- )
-            swap array-nth swap dup slip
-        ] 2keep
-    ] repeat 2drop ;
 
-M: object (each-slot) ( quot obj -- )
+M: object each-slot ( obj quot -- )
-    dup class "slots" word-prop [
+    over class "slots" word-prop [
-        pick pick >r >r car slot swap call r> r>
+        -rot [ >r swap first slot r> call ] 2keep
     ] each 2drop ;
 
-: each-slot ( obj quot -- )
-    #! Apply the quotation to each slot value of the object.
-    swap (each-slot) ; inline
-
 : refers? ( to obj -- ? )
     f swap [ pick eq? or ] each-slot nip ;