diff --git a/library/sequences-epilogue.factor b/library/sequences-epilogue.factor index 23ced82058..4c9a83c4ee 100644 --- a/library/sequences-epilogue.factor +++ b/library/sequences-epilogue.factor @@ -20,6 +20,9 @@ UNION: sequence array string sbuf vector ; M: object >list ( seq -- list ) dup length 0 rot (>list) ; M: general-list >list ( list -- list ) ; +: 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ; + +! Combinators GENERIC: (seq-each) ( quot seq -- ) inline M: object (seq-each) ( quot seq -- ) @@ -36,16 +39,20 @@ M: general-list (seq-each) ( quot seq -- ) swap [ with ] seq-each 2drop ; inline GENERIC: (tree-each) ( quot obj -- ) inline + M: object (tree-each) swap call ; + M: cons (tree-each) [ car (tree-each) ] 2keep cdr (tree-each) ; + M: f (tree-each) swap call ; + M: sequence (tree-each) [ swap call ] seq-each-with ; + : tree-each swap (tree-each) ; inline + : tree-each-with ( obj vector quot -- ) swap [ with ] tree-each 2drop ; inline -: 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ; - : (seq-2nmap) ( seq1 seq2 i quot -- elt3 ) pick pick >r >r >r 2nth r> call r> r> swap set-nth ; inline @@ -58,6 +65,7 @@ M: sequence (tree-each) [ swap call ] seq-each-with ; : seq-2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 ) >r clone r> over >r seq-2nmap r> ; inline +! Operations : index* ( obj i seq -- n ) #! The index of the object in the sequence, starting from i. 2dup length >= [ @@ -74,7 +82,7 @@ M: sequence (tree-each) [ swap call ] seq-each-with ; #! Push a value on the end of a sequence. dup length swap set-nth ; -: seq-append ( s1 s2 -- ) +: nappend ( s1 s2 -- ) #! Destructively append s2 to s1. [ over push ] seq-each drop ; @@ -88,6 +96,16 @@ M: sequence (tree-each) [ swap call ] seq-each-with ; : >pop> ( stack -- stack ) dup pop drop ; +: (nreverse) ( seq i -- ) + #! Swap seq[i] with seq[length-i-1]. + + ; + +: nreverse ( seq -- ) + #! Destructively reverse seq. + dup length 2 /i [ 2dup (nreverse) ] repeat drop ; + +! Equality testing : length= ( seq seq -- ? ) length swap length number= ; : (sequence=) ( seq seq i -- ? ) diff --git a/library/ui/tiles.factor b/library/ui/tiles.factor index 67ce1497ce..5f2c549903 100644 --- a/library/ui/tiles.factor +++ b/library/ui/tiles.factor @@ -6,7 +6,7 @@ USING: generic kernel math namespaces ; ! A tile is a gadget with a caption. Dragging the caption ! moves the gadget. The title bar also has buttons for ! performing various actions. -TUPLE: tile original ( size ) ; +TUPLE: tile original ; : click-rel ( gadget -- point ) screen-pos diff --git a/library/unix/io.factor b/library/unix/io.factor index 4520c532ef..2a12a46fec 100644 --- a/library/unix/io.factor +++ b/library/unix/io.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: io-internals USING: errors generic hashtables kernel lists math namespaces -sequences streams strings threads vectors ; +sequences stdio streams strings threads vectors ; ! These let us load the code into a CFactor instance using the ! old C-based I/O. They will be removed soon. @@ -55,7 +55,13 @@ GENERIC: io-task-events ( task -- events ) ! this with the hash-size call. SYMBOL: io-tasks -: init-io ( -- ) global [ io-tasks set ] bind ; +: init-io ( -- ) + #! Should only be called on startup. Calling this at any + #! other time can have unintended consequences. + global [ + io-tasks set + 0 1 stdio set + ] bind ; : io-task-fd io-task-port port-handle ; diff --git a/library/vectors-epilogue.factor b/library/vectors-epilogue.factor index b477b2fca4..6030a4fba4 100644 --- a/library/vectors-epilogue.factor +++ b/library/vectors-epilogue.factor @@ -16,8 +16,8 @@ IN: vectors : vector-append ( v1 v2 -- vec ) over length over length + - [ rot seq-append ] keep - [ swap seq-append ] keep ; + [ rot nappend ] keep + [ swap nappend ] keep ; : vector-project ( n quot -- vector ) #! Execute the quotation n times, passing the loop counter