diff --git a/library/collections/cons.factor b/library/collections/cons.factor index 03bbf6dd11..0b68ca0f3a 100644 --- a/library/collections/cons.factor +++ b/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. diff --git a/library/collections/lists.factor b/library/collections/lists.factor index 610e9cfaa0..da37c5bff0 100644 --- a/library/collections/lists.factor +++ b/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: - -IN: lists - -: count ( n -- [ 0 ... n-1 ] ) - 0 swap >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 > [ diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 68a075a6b7..82a5f8da72 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -234,6 +234,11 @@ M: object reverse ( seq -- seq ) [ ] 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 ) diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor index 6bfd170a7a..b289fce50a 100644 --- a/library/generic/builtin.factor +++ b/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 ; diff --git a/library/generic/complement.factor b/library/generic/complement.factor index ca9152fa03..38aa439ddd 100644 --- a/library/generic/complement.factor +++ b/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 diff --git a/library/generic/object.factor b/library/generic/object.factor index 0c91559d1f..e53c21513d 100644 --- a/library/generic/object.factor +++ b/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 [ diff --git a/library/generic/slots.factor b/library/generic/slots.factor index d5c5aea5ae..e960d0b60d 100644 --- a/library/generic/slots.factor +++ b/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 ] ) - [ reader-word ] 2keep writer-word 2list ; +: simple-slot ( class name -- reader writer ) + [ reader-word ] 2keep writer-word ; -: simple-slot-spec ( class slots -- spec ) - [ simple-slot ] map-with ; - -: simple-slots ( base class slots -- ) +: simple-slots ( class slots base -- spec ) #! Takes a list of slot names, and for each slot name #! defines a pair of words - and #! set--. Slot numbering is consecutive and #! begins at base. - >r tuck r> - simple-slot-spec [ length [ + ] project-with ] keep zip - define-slots ; + over length [ + ] map-with + [ >r dupd simple-slot r> -rot 3list ] 2map nip ; diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 011f8a639d..f938cb4a53 100644 --- a/library/generic/tuple.factor +++ b/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 - reverse [ peek unit , \ keep , ] each + "slots" word-prop 1 swap tail-slice reverse-slice + [ peek unit , \ keep , ] each ] make-list define-constructor ; : define-tuple ( tuple slots -- ) diff --git a/library/help/tutorial.factor b/library/help/tutorial.factor index 2c9ab2b006..960a170d64 100644 --- a/library/help/tutorial.factor +++ b/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." ] [ diff --git a/library/inference/branches.factor b/library/inference/branches.factor index e607ced654..ac43cb23fe 100644 --- a/library/inference/branches.factor +++ b/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 diff --git a/library/io/binary.factor b/library/io/binary.factor index fbb28b4406..128a9161c8 100644 --- a/library/io/binary.factor +++ b/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 ; diff --git a/library/math/integer.factor b/library/math/integer.factor index 5600a1fd9f..84878b7d47 100644 --- a/library/math/integer.factor +++ b/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 ; diff --git a/library/math/matrices.factor b/library/math/matrices.factor index 775da30b31..7792b25dfe 100644 --- a/library/math/matrices.factor +++ b/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 >list ] project-with ; + dup matrix-rows [ swap >vector ] map-with >list ; diff --git a/library/syntax/math.factor b/library/syntax/math.factor index 76d24d7fa1..daf3425145 100644 --- a/library/syntax/math.factor +++ b/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 swons ; parsing diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index e1d2a67ab3..3ecabe8475 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -53,11 +53,7 @@ M: word prettyprint* ( indent word -- indent ) ] when* ; : ?prettyprint-newline ( indent -- ) - one-line get [ - bl drop - ] [ - prettyprint-newline - ] ifte ; + one-line get [ bl drop ] [ prettyprint-newline ] ifte ; : r 3 + r> + \ M{ unparse. bl >r 3 + r> row-list matrix-rows. - bl \ ]M unparse. 3 - ; + bl \ }M unparse. 3 - ; : prettyprint ( obj -- ) [ diff --git a/library/test/continuations.factor b/library/test/continuations.factor index 3bcf782fec..3c8fd435b0 100644 --- a/library/test/continuations.factor +++ b/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 ) diff --git a/library/test/hashtables.factor b/library/test/hashtables.factor index 158c0e5221..c1b2224591 100644 --- a/library/test/hashtables.factor +++ b/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 ] diff --git a/library/test/lists/lists.factor b/library/test/lists/lists.factor index 580978042b..e5cd4471dc 100644 --- a/library/test/lists/lists.factor +++ b/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 1 2 3 ] ] [ 4 count ] unit-test +[ [ ] ] [ 0 >list ] unit-test +[ [ 0 1 2 3 ] ] [ 4 >list ] unit-test [ f ] [ 0 f head ] unit-test [ f ] [ 0 [ 1 ] head ] unit-test diff --git a/library/test/lists/queues.factor b/library/test/lists/queues.factor index 4ff439e0ef..c8a7251e6e 100644 --- a/library/test/lists/queues.factor +++ b/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 } ] [ [ 1 2 3 4 5 ] [ swap enque ] each - 5 [ drop deque swap ] project nip + 5 [ drop deque swap ] map nip ] unit-test diff --git a/library/test/math/matrices.factor b/library/test/math/matrices.factor index cf9a1978a0..ad133aa195 100644 --- a/library/test/math/matrices.factor +++ b/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 ] ] ] -[ M[ [ 1 4 ] [ 2 5 ] [ 3 6 ] ]M row-list ] unit-test +[ [ { 1 4 } { 2 5 } { 3 6 } ] ] +[ M{ { 1 4 } { 2 5 } { 3 6 } }M row-list ] unit-test [ - M[ [ 0 ] [ 0 ] [ 0 ] ]M + M{ { 0 } { 0 } { 0 } }M ] [ 3 1 ] unit-test [ - M[ [ 1 ] [ 2 ] [ 3 ] ]M + M{ { 1 } { 2 } { 3 } }M ] [ { 1 2 3 } ] unit-test [ - M[ [ 1 0 0 ] - [ 0 1 0 ] - [ 0 0 1 ] ]M + M{ { 1 0 0 } + { 0 1 0 } + { 0 0 1 } }M ] [ 3 ] unit-test [ - M[ [ 1 0 4 ] - [ 0 7 0 ] - [ 6 0 3 ] ]M + M{ { 1 0 4 } + { 0 7 0 } + { 6 0 3 } }M ] [ - M[ [ 1 0 0 ] - [ 0 2 0 ] - [ 0 0 3 ] ]M + M{ { 1 0 0 } + { 0 2 0 } + { 0 0 3 } }M - M[ [ 0 0 4 ] - [ 0 5 0 ] - [ 6 0 0 ] ]M + M{ { 0 0 4 } + { 0 5 0 } + { 6 0 0 } }M m+ ] unit-test [ - M[ [ 1 0 4 ] - [ 0 7 0 ] - [ 6 0 3 ] ]M + M{ { 1 0 4 } + { 0 7 0 } + { 6 0 3 } }M ] [ - M[ [ 1 0 0 ] - [ 0 2 0 ] - [ 0 0 3 ] ]M + M{ { 1 0 0 } + { 0 2 0 } + { 0 0 3 } }M - M[ [ 0 0 -4 ] - [ 0 -5 0 ] - [ -6 0 0 ] ]M + M{ { 0 0 -4 } + { 0 -5 0 } + { -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 ] - [ 0 1 ] ]M + M{ { 1 0 } + { 0 1 } }M { 3 4 } @@ -95,8 +95,8 @@ vectors ; [ { 4 3 } ] [ - M[ [ 0 1 ] - [ 1 0 ] ]M + M{ { 0 1 } + { 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 transpose transpose ] +[ M{ { 1 2 } { 3 4 } { 5 6 } }M ] +[ 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 transpose transpose ] +[ M{ { 1 3 5 } { 2 4 6 } }M ] +[ M{ { 1 3 5 } { 2 4 6 } }M transpose transpose ] unit-test -[ M[ [ 1 3 5 ] [ 2 4 6 ] ]M ] -[ M[ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]M transpose ] +[ M{ { 1 3 5 } { 2 4 6 } }M ] +[ 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 ] - [ 2 ] - [ 3 ] ]M + M{ { 1 } + { 2 } + { 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 - 5 [ 2 - swap ] project-with [ >vector ] map + M{ { 1 2 3 } { 4 5 6 } { 7 8 9 } }M + 5 [ 2 - swap >vector ] map-with ] unit-test [ { t t t } ] diff --git a/library/test/memory.factor b/library/test/memory.factor index 4ea4baedf3..4fd8d04cdd 100644 --- a/library/test/memory.factor +++ b/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 [ ] each-slot ] unit-test + [ ] [ num-types [ [ diff --git a/library/test/vectors.factor b/library/test/vectors.factor index 0bd1591bec..af90317719 100644 --- a/library/test/vectors.factor +++ b/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 >list >r reverse r> = + 100 >list dup >vector >list >r reverse r> = ] unit-test diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor index 2b584e96c7..c894d24699 100644 --- a/library/tools/inspector.factor +++ b/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 ; - -M: object sheet object-sheet 2list ; - -M: tuple sheet - dup object-sheet - >r >r \ delegate swap delegate r> r> - 2cons 2list ; + tuck [ execute ] map-with + 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 diff --git a/library/tools/memory.factor b/library/tools/memory.factor index f803cf39f0..af0ffe0d81 100644 --- a/library/tools/memory.factor +++ b/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 -- ) - dup array-capacity [ - [ - ( quot obj n -- ) - swap array-nth swap dup slip - ] 2keep - ] repeat 2drop ; +M: array each-slot ( array quot -- ) each ; -M: object (each-slot) ( quot obj -- ) - dup class "slots" word-prop [ - pick pick >r >r car slot swap call r> r> +M: object each-slot ( obj quot -- ) + over class "slots" word-prop [ + -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 ;